I'm trying to loop through two separate sheets going row by row starting at row 2 comparing multiple columns (Product Number, Date, Quantity) in Excel using VBA.
My nested loops are taking way too long. Is there another way to loop through, while cutting down on time, but being able to compare multiple columns at the same time?
For i = 2 To lastRow22
If ws2.Cells(i, 80) = 1 Or ws2.Cells(i, 80) = 2 Then
x = ws2.Cells(i, 79)
ElseIf ws2.Cells(i, 80) = 0 Then
x = ws2.Cells(i, 1)
End If
x2 = Trim(ws2.Cells(i, 81))
xDate = Trim(ws2.Cells(i, 19))
xQD = Trim(ws2.Cells(i, 20))
For j = 2 To lastRow33
y = Trim(ws3.Cells(j, 28))
y2 = Trim(ws3.Cells(j, 10))
yDate = Trim(ws3.Cells(j, 13))
yQD = Trim(ws3.Cells(j, 17))
If x = y And xDate = yDate And xQD = yQD And ws2.Cells(i, 82) = 0 And ws3.Cells(j, 27) = 0 Then
ws3.Cells(j, 1).Interior.Color = vbGreen
ws2.Cells(i, 1).Interior.Color = vbGreen
ws2.Cells(i, 82) = 1
ws3.Cells(j, 27) = 1
ElseIf x2 = y2 And xDate = yDate And xQD = yQD And ws2.Cells(i, 82) = 0 And ws3.Cells(j, 27) = 0 Then
ws3.Cells(j, 1).Interior.Color = vbGreen
ws2.Cells(i, 1).Interior.Color = vbGreen
ws2.Cells(i, 82) = 1
ws3.Cells(j, 27) = 1
End If
Next j
Next i
-
1\$\begingroup\$ Can you post the full code? Ideally we should at least know how the loop is being initialized/called. \$\endgroup\$Brandon Barney– Brandon Barney2017年07月31日 17:19:49 +00:00Commented Jul 31, 2017 at 17:19
-
1\$\begingroup\$ Can you please also edit your question title to confirm to CR norms that your question state what your entire program does? \$\endgroup\$user79074– user790742017年07月31日 18:14:05 +00:00Commented Jul 31, 2017 at 18:14
-
\$\begingroup\$ Cross-posted from Stack Overflow. As a courtesy to other users, please declare your cross-posting in the future. Unlike Stack Overflow, on Code Review, we expect to be given sufficient contextual information about how your code works, such as what your spreadsheet looks like, and the circumstances in which you are calling this code. Also, please retitle the question to state the task accomplished by the code, as per the site guidelines — see How to Ask. \$\endgroup\$200_success– 200_success2017年07月31日 21:19:42 +00:00Commented Jul 31, 2017 at 21:19
1 Answer 1
1. Too Many Spreadsheet Reads and Writes
Would you be comfortable turning ws2.Range(ws2.Cells(2,1),ws2.Cells(lastRow22,80))
into an array? You can do that like this:
Dim arrEntireWs2() as Variant
With ws2
arrEntireWs2 = .Range(.Cells(2,1),.Cells(lastRow22,80)).Value
End With
By cutting out all of those spreadsheet reads and writes, you'll be able to make all your checks and value changes much less expensively. Loop through the array like this (assuming from your code you want to loop through rows):
Dim lngArrEntireWs2Index as Long
For lngArrEntireWs2Index = LBound(arrEntireWs2,1) to Ubound(arrEntireWs2,1)
<stuff you want to do here>
Next lngArrEntireWs2Index
And write it all to the spreadsheet one time like this:
With ws2
.Cells(2,1).Resize(Ubound(arrEntireWs2,1), Ubound(arrEntireWs2,2)).Value = arrEntireWs2
End With
Using arrays will save you the most time, but one other habit I have is to do this:
2. VBA doesn't support short-circuit evaluation, so add it manually
Others will have different preferences since doing this makes your code uglier and thus less maintainable, but at the moment I currently prefer to implement manual short-circuit evaluation by breaking multiple-condition If And
lines into several pieces. Thus:
If x = y And xDate = yDate And xQD = yQD And ws2.Cells(i, 82) = 0 And ws3.Cells(j, 27) = 0 Then
becomes:
If x = y Then
If xDate = yDate Then
If xQD = yQD Then
If ws2.Cells(i, 82) = 0 Then
If ws3.Cells(j, 27) = 0 Then
<do stuff>
End If
End If
End If
End If
End If
There's could be a more sensible way to deal with your logic that doesn't involve Arrow Code, but without more of your code available, it's hard for me to help further.
-
1\$\begingroup\$ Ditch the Hungarian Notation
lng
andarr
, but otherwise great suggestions. \$\endgroup\$FreeMan– FreeMan2017年07月31日 18:01:18 +00:00Commented Jul 31, 2017 at 18:01 -
\$\begingroup\$ ^ Agreed. Please dont teach newbies bad habits :). \$\endgroup\$Brandon Barney– Brandon Barney2017年07月31日 18:02:35 +00:00Commented Jul 31, 2017 at 18:02