Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes

Looks up a number from sheet 1, Column A in Sheet 2 Column E, and posts offsets from both the left and right of that Col E number back to Column A.

Once the post has been completed the worksheet/book freezes and offers a not responding massage. Restart of Excel is required.

The commented out code works okay until a Column A number does not exist in Sheet 2 Column E, and the posts back to sheet 1 are posted wrong because of the .End(xlUp)(2).

Thanks.
Howard

Option Explicit

Sub ListNewPN()

Dim rngPN As Range
Dim c As Range, i As Range
Dim ws1Part_Num As Range
Dim ws2From_Item As Range

Set ws1Part_Num = Sheets("Sheet1"). _
Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

Set ws2From_Item = Sheets("Sheet2"). _
Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)

For Each c In ws1Part_Num

Set rngPN = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)

If Not rngPN Is Nothing Then

For Each i In ws1Part_Num

If i = rngPN Then
i.Offset(0, 1) = rngPN.End(xlToRight)
i.Offset(0, 2) = rngPN.End(xlToLeft)
End If

'Sheets("Sheet1").Range("B100").End(xlUp)(2) _
= rngPN.End(xlToRight)

'Sheets("Sheet1").Range("C100").End(xlUp)(2) _
= rngPN.End(xlToLeft)

Next
End If
Next

End Sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Code works but goes into endless loop and crashes

Hi Howard,

Am Mon, 7 Oct 2013 10:09:08 -0700 (PDT) schrieb Howard:

Looks up a number from sheet 1, Column A in Sheet 2 Column E, and posts offsets from both the left and right of that Col E number back to Column A.

Once the post has been completed the worksheet/book freezes and offers a not responding massage. Restart of Excel is required.


I hope I understood your problem.
Try:

Sub ListNewPN()

Dim rngPN As Range
Dim c As Range
Dim ws1Part_Num As Range
Dim ws2From_Item As Range
Dim firstaddress As String
Dim LRow1 As Long
Dim LRow2 As Long

With Sheets("Sheet1")
LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
Set ws1Part_Num = .Range("A1:A" & LRow1)
End With

With Sheets("Sheet2")
LRow2 = .Cells(.Rows.Count, 5).End(xlUp).Row
Set ws2From_Item = .Range("E1:E" & LRow2)


For Each c In ws1Part_Num
Set rngPN = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)

If Not rngPN Is Nothing Then
Do
firstaddress = c.Address
c.Offset(0, 1) = rngPN.Offset(, -1)
c.Offset(0, 2) = rngPN.Offset(, 1)
Set rngPN = ws2From_Item.FindNext(rngPN)
Loop While Not c Is Nothing And c.Address < firstaddress
End If
Next c
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Code works but goes into endless loop and crashes

Hi Howard,

Am Mon, 7 Oct 2013 19:48:05 +0200 schrieb Claus Busch:

sorry, there is an error into the code. Try:

Sub ListNewPN()

Dim rngPN As Range
Dim c As Range
Dim ws1Part_Num As Range
Dim ws2From_Item As Range
Dim firstaddress As String
Dim LRow1 As Long
Dim LRow2 As Long

With Sheets("Sheet1")
LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
Set ws1Part_Num = .Range("A1:A" & LRow1)
End With

With Sheets("Sheet2")
LRow2 = .Cells(.Rows.Count, 5).End(xlUp).Row
Set ws2From_Item = .Range("E1:E" & LRow2)


For Each c In ws1Part_Num
Set rngPN = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)

If Not rngPN Is Nothing Then
Do
firstaddress = rngPN.Address
c.Offset(0, 1) = rngPN.Offset(, -1)
c.Offset(0, 2) = rngPN.Offset(, 1)
Set rngPN = ws2From_Item.FindNext(rngPN)
Loop While Not rngPN Is Nothing And rngPN.Address < firstaddress
End If
Next c
End With
End Sub



Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes

On Monday, October 7, 2013 10:53:00 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Mon, 7 Oct 2013 19:48:05 +0200 schrieb Claus Busch:



sorry, there is an error into the code. Try:



Sub ListNewPN()



Dim rngPN As Range

Dim c As Range

Dim ws1Part_Num As Range

Dim ws2From_Item As Range

Dim firstaddress As String

Dim LRow1 As Long

Dim LRow2 As Long



With Sheets("Sheet1")

LRow1 = .Cells(.Rows.Count, 1).End(xlUp).Row

Set ws1Part_Num = .Range("A1:A" & LRow1)

End With



With Sheets("Sheet2")

LRow2 = .Cells(.Rows.Count, 5).End(xlUp).Row

Set ws2From_Item = .Range("E1:E" & LRow2)





For Each c In ws1Part_Num

Set rngPN = ws2From_Item.Find(c, LookIn:=xlValues, _

lookat:=xlWhole)



If Not rngPN Is Nothing Then

Do

firstaddress = rngPN.Address

c.Offset(0, 1) = rngPN.Offset(, -1)

c.Offset(0, 2) = rngPN.Offset(, 1)

Set rngPN = ws2From_Item.FindNext(rngPN)

Loop While Not rngPN Is Nothing And rngPN.Address < firstaddress

End If

Next c

End With

End Sub


Regards

Claus B.



Hi Claus,

Here is a link to my workbook.

https://www.dropbox.com/s/zlqt546kno...rop%20Box.xlsm

Am getting a freeze up with you code also.
See sheet 1, has a few words about what the results should be.

Basically if the number in col A sheet 1 is found in sheet 2 col E, then an offset to the left and to the right of that found number is posted in col B & C on sheet 1.

The 123 & 456 numbers in col A sheet 1 are not in col E of sheet 2, so their returns should be "" (Blank).

Thanks.
Howard
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Code works but goes into endless loop and crashes

Hi Howard,

Am Mon, 7 Oct 2013 11:49:39 -0700 (PDT) schrieb Howard:

https://www.dropbox.com/s/zlqt546kno...rop%20Box.xlsm

Am getting a freeze up with you code also.
See sheet 1, has a few words about what the results should be.


please have a look:
https://skydrive.live.com/#cid=9378A...121822A3%21326
for workbook "Master & MSA"
The button and my code works
(Procedures has to be placed in a standard module)



Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes

On Monday, October 7, 2013 12:12:56 PM UTC-7, Claus Busch wrote:
Hi Howard,



Am Mon, 7 Oct 2013 11:49:39 -0700 (PDT) schrieb Howard:



https://www.dropbox.com/s/zlqt546kno...rop%20Box.xlsm




Am getting a freeze up with you code also.


See sheet 1, has a few words about what the results should be.




please have a look:

https://skydrive.live.com/#cid=9378A...121822A3%21326

for workbook "Master & MSA"

The button and my code works

(Procedures has to be placed in a standard module)


Regards

Claus B.


Yes, it does indeed!

Works with blanks, non match numbers and blanks.

Always impressed, and even more grateful.

Thanks,
Howard

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes



Yes, it does indeed!



Works with blanks, non match numbers and blanks.



Always impressed, and even more grateful.



Thanks,

Howard


What would I change in the code so that this part will return the values of formulas and some of those formulas will return values like 1234, AX-123, AAA2?

Code, as is, returns numeric values just fine, but not if they are from a formula. Seems like I need a paste special values somewhere...

If Not rngPN Is Nothing Then
c.Offset(0, 1) = WorksheetFunction.Max(.Rows(rngPN.Row))
c.Offset(0, 2) = WorksheetFunction.Min(.Rows(rngPN.Row))
Set rngPN = ws2From_Item.FindNext(rngPN)
End If

Howard
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Code works but goes into endless loop and crashes

Hi Howard,

Am Tue, 8 Oct 2013 13:11:59 -0700 (PDT) schrieb Howard:

Code, as is, returns numeric values just fine, but not if they are from a formula. Seems like I need a paste special values somewhere...

If Not rngPN Is Nothing Then
c.Offset(0, 1) = WorksheetFunction.Max(.Rows(rngPN.Row))
c.Offset(0, 2) = WorksheetFunction.Min(.Rows(rngPN.Row))
Set rngPN = ws2From_Item.FindNext(rngPN)
End If


change to:
If Not rngPN Is Nothing Then
c.Offset(0, 1) = .Cells(rngPN.Row, Columns.Count).End(xlToLeft)
c.Offset(0, 2) = .Cells(rngPN.Row, WorksheetFunction. _
CountBlank(.Range(.Cells(rngPN.Row, 1), .Cells(rngPN.Row, 5))) + 1)
Set rngPN = ws2From_Item.FindNext(rngPN)
End If


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes

change to:

If Not rngPN Is Nothing Then

c.Offset(0, 1) = .Cells(rngPN.Row, Columns.Count).End(xlToLeft)

c.Offset(0, 2) = .Cells(rngPN.Row, WorksheetFunction. _

CountBlank(.Range(.Cells(rngPN.Row, 1), .Cells(rngPN.Row, 5))) + 1)

Set rngPN = ws2From_Item.FindNext(rngPN)

End If


Regards

Claus B.


Hi Claus, that seems to take care of the values issue for sure.

I need the line:

c.Offset(0, 1) = .Cells(rngPN.Row, Columns.Count).End(xlToLeft)

to start at column 14 and come to the left from there. There is data on out to the right of column M. Column M would be as far as the returns to the right will go.

So the returns will be the last value to the right of G in any of the rows of cols H, I, J, K, L.

I tried inserting 14 in the line of code to denote where to xlToLeft should start, but to no avail.

The returns from the left of col G work fine.

Howard
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes

On Tuesday, October 8, 2013 3:35:05 PM UTC-7, Howard wrote:
change to:




If Not rngPN Is Nothing Then




c.Offset(0, 1) = .Cells(rngPN.Row, Columns.Count).End(xlToLeft)




c.Offset(0, 2) = .Cells(rngPN.Row, WorksheetFunction. _




CountBlank(.Range(.Cells(rngPN.Row, 1), .Cells(rngPN.Row, 5))) + 1)




Set rngPN = ws2From_Item.FindNext(rngPN)




End If




Regards




Claus B.




Hi Claus, that seems to take care of the values issue for sure.



I need the line:



c.Offset(0, 1) = .Cells(rngPN.Row, Columns.Count).End(xlToLeft)



to start at column 14 and come to the left from there. There is data on out to the right of column M. Column M would be as far as the returns to the right will go.



So the returns will be the last value to the right of G in any of the rows of cols H, I, J, K, L.



I tried inserting 14 in the line of code to denote where to xlToLeft should start, but to no avail.



The returns from the left of col G work fine.



Howard


Actually column M should be included in this statement.

So the returns will be the last value to the right of G in any of the rows of cols H, I, J, K, L, M

H'wd


  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes

Hi Claus, that seems to take care of the values issue for sure.


I need the line:




c.Offset(0, 1) = .Cells(rngPN.Row, Columns.Count).End(xlToLeft)



to start at column 14 and come to the left from there. There is data on out to the right of column M. Column M would be as far as the returns to the right will go.




So the returns will be the last value to the right of G in any of the rows of cols H, I, J, K, L.



I tried inserting 14 in the line of code to denote where to xlToLeft should start, but to no avail.



So the returns will be the last value to the right of G in any of the rows of cols H, I, J, K, L, M


H'wd


A bit simpler than I thought, this seems to work just fine:

c.Offset(0, 1) = .Cells(rngPN.Row, 14).End(xlToLeft)

Howard
  #12   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes


A bit simpler than I thought, this seems to work just fine:


c.Offset(0, 1) = .Cells(rngPN.Row, 14).End(xlToLeft)


Howard



Well, drat! I'm back at it again.
The line just below 'Right ultimate job is to start at column 14, if col 14 has a value that is returned by the Vlookup formula in that cell, then post that value to the c.Offset(0, 1) as indicated.

If the formula has returned a "", then move to the next cell left and repeat until it finds a value returned by the VLOOKUP formula. So, M to L to K to J to I to H looking for a value. If no value in those six columns then post a 0 to the c.Offset(0, 1).

What the code is doing now is stopping at the first cell with a formula, and returning a 0. So, as the sheet is set up that would be column M. I deleted some formulas in a row and the code goes the the first cell in the row with a formula and returns a 0 or the value from the formula.

All those cells contain a formula like this:

=IFERROR(VLOOKUP(G3,'SUP SEP'!$A$2:$G$5184,6,0),"")

The line of code below 'Left works just fine for columns B, C, D, E, F.

All those cells contain a formula like this:

=IFERROR(INDEX('SUP SEP'!$A$1:$A$9191,MATCH(C2,'SUP SEP'!$F$1:$F$9191,0)),"")


If Not rngPN Is Nothing Then

'Right
c.Offset(0, 1) = .Cells(rngPN.Row, 14).End(xlToLeft)

'Left
c.Offset(0, 2) = .Cells(rngPN.Row, WorksheetFunction. _
CountBlank(.Range(.Cells(rngPN.Row, 1), .Cells(rngPN.Row, 5))) + 1)

Set rngPN = ws2From_Item.FindNext(rngPN)
End If

Thanks. Howard
  #13   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Code works but goes into endless loop and crashes

Hi Howard,

Am Tue, 8 Oct 2013 22:41:43 -0700 (PDT) schrieb Howard:

What the code is doing now is stopping at the first cell with a formula, and returning a 0. So, as the sheet is set up that would be column M. I deleted some formulas in a row and the code goes the the first cell in the row with a formula and returns a 0 or the value from the formula.


sorry for answers delay, but I have been sleeping.

Try:
If Not rngPN Is Nothing Then
For i = 14 To 6 Step -1
If .Cells(rngPN.Row, i) < "" Then
c.Offset(0, 1) = .Cells(rngPN.Row, i)
Exit For
End If
Next
c.Offset(0, 2) = .Cells(rngPN.Row, WorksheetFunction. _
CountBlank(.Range(.Cells(rngPN.Row, 1), .Cells(rngPN.Row, 5))) + 1)
End If

The line with findnext you can delete because the values are unique and
you don't have to find another value


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #14   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Code works but goes into endless loop and crashes

Hi again,

Am Wed, 9 Oct 2013 07:59:13 +0200 schrieb Claus Busch:

If Not rngPN Is Nothing Then
For i = 14 To 6 Step -1
If .Cells(rngPN.Row, i) < "" Then
c.Offset(0, 1) = .Cells(rngPN.Row, i)
Exit For
End If
Next
c.Offset(0, 2) = .Cells(rngPN.Row, WorksheetFunction. _
CountBlank(.Range(.Cells(rngPN.Row, 1), .Cells(rngPN.Row, 5))) + 1)
End If


or try it with an array:

If Not rngPN Is Nothing Then
ReDim varOut(1 To 1, 1 To 14)
varOut = .Range(.Cells(rngPN.Row, 1), .Cells(rngPN.Row, 14))
For i = 14 To 1 Step -1
If varOut(1, i) < "" Then
c.Offset(0, 1) = varOut(1, i)
Exit For
End If
Next
For i = 1 To 14
If varOut(1, i) < "" Then
c.Offset(0, 2) = varOut(1, i)
Exit For
End If
Next
End If

you can also look again to the workbook in Skydrive
There are now 2 codes:
ListNewPNClaus and ListNewPNClaus2


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #15   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes


you can also look again to the workbook in Skydrive

There are now 2 codes:

ListNewPNClaus and ListNewPNClaus2





Regards

Claus B.


I'm liking this except if the .Cells(rngPN.Row, i) all = "" then it returns the rngPN, which is in column G. (I had to change the 14 to 13 as it was returning whatever was in column N each time)

I'm at a loss as to how to make the code stop at column H if the formulas all return "" in a row.

For i = 13 To 6 Step -1
If .Cells(rngPN.Row, i) < "" Then
c.Offset(0, 1) = .Cells(rngPN.Row, i)
Exit For
End If

Thanks.
Howard


  #16   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default Code works but goes into endless loop and crashes

Hi Howard,

Am Wed, 9 Oct 2013 00:20:46 -0700 (PDT) schrieb Howard:

For i = 13 To 6 Step -1
If .Cells(rngPN.Row, i) < "" Then
c.Offset(0, 1) = .Cells(rngPN.Row, i)
Exit For
End If


change it to:
For i = 13 To 8 Step -1
If .Cells(rngPN.Row, i) < "" Then
c.Offset(0, 1) = .Cells(rngPN.Row, i)
Exit For
End If
Next

If all cells have "" then you get no entry


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
  #17   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 536
Default Code works but goes into endless loop and crashes

On Wednesday, October 9, 2013 12:29:15 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Wed, 9 Oct 2013 00:20:46 -0700 (PDT) schrieb Howard:



For i = 13 To 6 Step -1


If .Cells(rngPN.Row, i) < "" Then


c.Offset(0, 1) = .Cells(rngPN.Row, i)


Exit For


End If




change it to:

For i = 13 To 8 Step -1

If .Cells(rngPN.Row, i) < "" Then

c.Offset(0, 1) = .Cells(rngPN.Row, i)

Exit For

End If

Next



If all cells have "" then you get no entry





Regards

Claus B.


Works great. Thanks Claus. Appreciate it.

Regards,
Howard
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Endless Loop - Shortcut Key To Stop Code? dim Excel Programming 5 December 31st 07 01:29 AM
endless loop - using input box [email protected] Excel Programming 2 February 8th 07 05:26 AM
Endless loop freddie mac Excel Programming 2 August 1st 06 03:19 PM
endless loop help John Excel Programming 1 October 26th 05 04:51 PM
Endless loop? John Excel Programming 24 August 2nd 05 06:41 PM


All times are GMT +1. The time now is 06:08 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"