Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi,
I've optimized some vba code you folks helped me with the other day to use find instead of nested for loops, and added some conditional statements specific to my application. When I run the macro, I only get partial results; about 353 rows of them (loops through 353*6 ID's (rows in sheet 1)), and then the macro is interrupted with an object type mismatch error on this line. c = ws2.Range("A2:A" & lr2).Find(What:=ID, After:=ws2.Cells(lr2, 1), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False).Row Do I just need to write an on error line? Why would it run over 2,000 times successfully and then break? Any insights would be awesome, I've listed my code at the bottom. Thanks again! Sub Model() Application.ScreenUpdating = False Dim lr1 As Long, lr2 As Long, lr3 As Long Dim x As Long, y As Long, constraints As Long Dim pos As Long, ID As Variant, c As Long 'ws1: hh's Set ws1 = ThisWorkbook.Sheets(1) 'ws2: ps's Set ws2 = ThisWorkbook.Sheets(2) 'ws3: copy dest Set ws3 = ThisWorkbook.Sheets(3) 'length of ps array lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 'length of hh array lr1 = ws1.Cells(Rows.Count, 2).End(xlUp).Row 'init row dest in ws3 x = 2 'how many IDs are in present row y = 1 'look through the constraints and if the ID's match: For Each ID In ws1.Range("B2:B" & lr1) c = ws2.Range("A2:A" & lr2).Find(What:=ID, After:=ws2.Cells(lr2, 1), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=False).Row 'lc3 is in ws3; number of columns in row x lc3 = ws3.Cells(x, Columns.Count).End(xlToLeft).Column constraints = ws2.Cells(c, 2).Value pos = ws1.Cells(ID.Row, 4).Value If lc3 = 1 Then If constraints 1000 Then ' If pos = 0 Or pos = 1 Then ws2.Range("U" & c).Copy _ ws3.Cells(x, lc3) End If If pos = 2 Or pos = 3 Then ws2.Range("T" & c).Copy _ ws3.Cells(x, lc3) End If If pos = 9 Or pos = 8 Then ws2.Range("V" & c).Copy _ ws3.Cells(x, lc3) End If Else ws2.Range("W" & c).Copy _ ws3.Cells(x, lc3) End If If constraints 300 Then ' If pos = 3 Then ws2.Range("F" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If pos = 2 Then ws2.Range("G" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If pos = 1 Then ws2.Range("H" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If pos = 0 Then ws2.Range("I" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If pos = 9 Then ws2.Range("J" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If pos = 8 Then ws2.Range("K" & c).Copy _ ws3.Cells(x, lc3 + 1) End If Else ws2.Range("L" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If constraints 300 Then ' If pos = 3 Then ws2.Range("M" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 2 Then ws2.Range("N" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 1 Then ws2.Range("O" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 0 Then ws2.Range("P" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 9 Then ws2.Range("Q" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 8 Then ws2.Range("R" & c).Copy _ ws3.Cells(x, lc3 + 2) End If Else ws2.Range("S" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If constraints 600 Then ' If pos = 0 Or pos = 1 Or pos = 2 Then ws2.Range("C" & c).Copy _ ws3.Cells(x, lc3 + 3) Else ws2.Range("D" & c).Copy _ ws3.Cells(x, lc3 + 3) End If Else ws2.Range("E" & c).Copy _ ws3.Cells(x, lc3 + 3) End If y = y + 1 Else If constraints 1000 Then ' If pos = 0 Or pos = 1 Then ws2.Range("U" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If pos = 2 Or pos = 3 Then ws2.Range("T" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If pos = 8 Or pos = 9 Then ws2.Range("V" & c).Copy _ ws3.Cells(x, lc3 + 1) End If Else ws2.Range("W" & c).Copy _ ws3.Cells(x, lc3 + 1) End If If constraints 300 Then ' If pos = 3 Then ws2.Range("F" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 2 Then ws2.Range("G" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 1 Then ws2.Range("H" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 0 Then ws2.Range("I" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 9 Then ws2.Range("J" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If pos = 8 Then ws2.Range("K" & c).Copy _ ws3.Cells(x, lc3 + 2) End If Else ws2.Range("L" & c).Copy _ ws3.Cells(x, lc3 + 2) End If If constraints 300 Then ' If pos = 3 Then ws2.Range("M" & c).Copy _ ws3.Cells(x, lc3 + 3) End If If pos = 2 Then ws2.Range("N" & c).Copy _ ws3.Cells(x, lc3 + 3) End If If pos = 1 Then ws2.Range("O" & c).Copy _ ws3.Cells(x, lc3 + 3) End If If pos = 0 Then ws2.Range("P" & c).Copy _ ws3.Cells(x, lc3 + 3) End If If pos = 9 Then ws2.Range("Q" & c).Copy _ ws3.Cells(x, lc3 + 3) End If If pos = 8 Then ws2.Range("R" & c).Copy _ ws3.Cells(x, lc3 + 3) End If Else ws2.Range("S" & c).Copy _ ws3.Cells(x, lc3 + 3) End If If constraints 600 Then ' If pos = 0 Or pos = 1 Or pos = 2 Then ws2.Range("C" & c).Copy _ ws3.Cells(x, lc3 + 4) Else ws2.Range("D" & c).Copy _ ws3.Cells(x, lc3 + 4) End If Else ws2.Range("E" & c).Copy _ ws3.Cells(x, lc3 + 4) End If y = y + 1 End If If y = 7 Then x = x + 1 y = 1 End If Next Application.ScreenUpdating = True End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Need help with Debug | Excel Programming | |||
Quick question - quick answer about assigning shortcut keys | Excel Programming | |||
* How do we debug this? ... | Excel Programming | |||
debug | Excel Programming | |||
debug help | Excel Programming |