Mike_A
06-13-2006, 10:23 PM
This loop takes about 20 minutes to complete when ran. I'd like to see if I can speed it up. Any help would be appreciated. "Lastrow" in the first loop is usually around 1,000, and "LastWOrow" in the second loop is usually around 12,000. Both documents are pure data without formulas.
-----------------------------------------------------
Application.ScreenUpdating = False
Lastrow = Range("I65536").End(xlUp).Row
For I = 2 To Lastrow
Workbooks("PRODUCTION REPORT.XLS").Activate
WOSEARCH = Range("L" & I).Value
Workbooks("WOCOLL.XLS").Activate
LastWOrow = Range("I65536").End(xlUp).Row
For J = LastWOrow To 2 Step -1
If Range("Y" & J).Value = WOSEARCH Then
Range("C" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("O" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Range("R" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("P" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Range("X" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("Q" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Range("G" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("R" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Exit For
End If
Next J
Next I
Application.Screenupdating = True
-----------------------------------------------------
Application.ScreenUpdating = False
Lastrow = Range("I65536").End(xlUp).Row
For I = 2 To Lastrow
Workbooks("PRODUCTION REPORT.XLS").Activate
WOSEARCH = Range("L" & I).Value
Workbooks("WOCOLL.XLS").Activate
LastWOrow = Range("I65536").End(xlUp).Row
For J = LastWOrow To 2 Step -1
If Range("Y" & J).Value = WOSEARCH Then
Range("C" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("O" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Range("R" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("P" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Range("X" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("Q" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Range("G" & J).Copy
Workbooks("PRODUCTION REPORT.XLS").Activate
Range("R" & I).PasteSpecial
Workbooks("WOCOLL.XLS").Activate
Exit For
End If
Next J
Next I
Application.Screenupdating = True