Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Endless Loop - Shortcut Key To Stop Code? | Excel Programming | |||
endless loop - using input box | Excel Programming | |||
Endless loop | Excel Programming | |||
endless loop help | Excel Programming | |||
Endless loop? | Excel Programming |