LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 13
Default Quick Debug Help

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
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
Need help with Debug Newbee via OfficeKB.com Excel Programming 3 February 26th 07 06:57 PM
Quick question - quick answer about assigning shortcut keys funkymonkUK[_75_] Excel Programming 1 October 13th 05 10:50 AM
* How do we debug this? ... Kris Excel Programming 2 October 29th 04 02:17 AM
debug Frank Kabel Excel Programming 0 September 22nd 04 06:22 AM
debug help Tom Ogilvy Excel Programming 0 August 27th 03 07:10 PM


All times are GMT +1. The time now is 08:32 AM.

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

About Us

"It's about Microsoft Excel"