Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Quick Debug Help
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #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


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Quick Debug Help
I don't know why you need After:=ws2.Cells(lr2, 1)

The Range ws2.Range("A2:A" & lr2) and the after both are at the same row of
the worksheet. So the code will start on the last row of the range lr2 and
then wrap to the beginning of the range at row 2.

You also have a problem if the object isn't found. It is better to do it
this way

set c = ws2.Range("A2:A" & lr2).Find(What:=ID, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
MatchCase:=False)

if not c is nothing then
'lc3 is in ws3; number of columns in row x
lc3 = ws3.Cells(x, Columns.Count).End(xlToLeft).Column
constraints = ws2.Cells(c.row, 2).Value

'put the rest of your code here. Notice I changed c to c.row in the line
where you get the restraints. I also removed the after clause in the FIND.

"badmrfrosty8" wrote:

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, _
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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 13
Default Quick Debug Help
Thanks for the help, I put in your changes, closed off the extra if and
updated c to c.row. I noticed that the macro seemed to run faster, but still
get a type mismatch error on the set c line once i hit 353 rows.I scoped out
what the entry was in sheet 1 at row 353*6 and row 353*6+1 and those were
just text, but! a few cells up and down from there were entries that began
with nonprintable characters, giving a #NAME? error. Do I need to convert
names to ASCII or run a clean here? How would I implement that to avoid
getting wrong matches? I would need to clean OR convert to a numeric string
the variable ID and I guess C as well. Thanks again for helping me out!


"Joel" wrote:

I don't know why you need After:=ws2.Cells(lr2, 1)

The Range ws2.Range("A2:A" & lr2) and the after both are at the same row of
the worksheet. So the code will start on the last row of the range lr2 and
then wrap to the beginning of the range at row 2.

You also have a problem if the object isn't found. It is better to do it
this way

set c = ws2.Range("A2:A" & lr2).Find(What:=ID, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
MatchCase:=False)

if not c is nothing then
'lc3 is in ws3; number of columns in row x
lc3 = ws3.Cells(x, Columns.Count).End(xlToLeft).Column
constraints = ws2.Cells(c.row, 2).Value

'put the rest of your code here. Notice I changed c to c.row in the line
where you get the restraints. I also removed the after clause in the FIND.

"badmrfrosty8" wrote:

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, _
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


Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 13
Default Quick Debug Help
nm, got it myself. thanks!

"badmrfrosty8" wrote:

Thanks for the help, I put in your changes, closed off the extra if and
updated c to c.row. I noticed that the macro seemed to run faster, but still
get a type mismatch error on the set c line once i hit 353 rows.I scoped out
what the entry was in sheet 1 at row 353*6 and row 353*6+1 and those were
just text, but! a few cells up and down from there were entries that began
with nonprintable characters, giving a #NAME? error. Do I need to convert
names to ASCII or run a clean here? How would I implement that to avoid
getting wrong matches? I would need to clean OR convert to a numeric string
the variable ID and I guess C as well. Thanks again for helping me out!


"Joel" wrote:

I don't know why you need After:=ws2.Cells(lr2, 1)

The Range ws2.Range("A2:A" & lr2) and the after both are at the same row of
the worksheet. So the code will start on the last row of the range lr2 and
then wrap to the beginning of the range at row 2.

You also have a problem if the object isn't found. It is better to do it
this way

set c = ws2.Range("A2:A" & lr2).Find(What:=ID, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
MatchCase:=False)

if not c is nothing then
'lc3 is in ws3; number of columns in row x
lc3 = ws3.Cells(x, Columns.Count).End(xlToLeft).Column
constraints = ws2.Cells(c.row, 2).Value

'put the rest of your code here. Notice I changed c to c.row in the line
where you get the restraints. I also removed the after clause in the FIND.

"badmrfrosty8" wrote:

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, _
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


Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

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 10:03 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"

 

Contact Us ExcelBanter forum home Privacy Statement