PDA

View Full Version : Solved: Help with a Loop in a Loop



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

mdmackillop
06-14-2006, 12:46 AM
Hi Mike
Welcome to VBAX

Without changing your approach, try

Sub AnyQuicker()
Dim WB1 As Workbook, i As Long, j As Long
Set WB1 = Workbooks("PRODUCTION REPORT.XLS")
Application.ScreenUpdating = False

Lastrow = Range("I65536").End(xlUp).Row

For i = 2 To Lastrow
WOSEARCH = WB1.Sheets(1).Range("L" & i).Value
LastWOrow = Range("I65536").End(xlUp).Row

For j = LastWOrow To 2 Step -1
If Range("Y" & j).Value = WOSEARCH Then

With WB1.Sheets(1)
Range("C" & j).Copy
.Range("O" & i).PasteSpecial

Range("R" & j).Copy
.Range("P" & i).PasteSpecial

Range("X" & j).Copy
.Range("Q" & i).PasteSpecial

Range("G" & j).Copy
.Range("R" & i).PasteSpecial
End With

Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub



Do you really need the Copy/Paste Special method? How about

With WB1.Sheets(1)
.Range("O" & i) = Range("C" & j)
.Range("P" & i) = Range("R" & j)
.Range("Q" & i) = Range("X" & j)
.Range("R" & i) = Range("G" & j)
End With

Bob Phillips
06-14-2006, 01:12 AM
Dim LastRow As Long
Dim LastWORow As Long
Dim i As Long, j As Long
Dim WOSEARCH
Dim shBook1 As Worksheet
Dim shBook2 As Worksheet
Const BOOK1 As String = "PRODUCTION REPORT.XLS"
Const BOOK2 As String = "WOCOLL.XLS"
Application.ScreenUpdating = False

LastRow = Range("I" & Rows.Count).End(xlUp).Row

Set shBook1 = Workbooks(BOOK1).Worksheets(1)
Set shBook2 = Workbooks(BOOK2).Worksheets(1)

For i = 2 To LastRow
WOSEARCH = shBook1.Range("L" & i).Value
LastWORow = shBook2.Range("I" & shBook2.Rows.Count).End(xlUp).Row

For j = LastWORow To 2 Step -1
If shBook2.Range("Y" & j).Value = WOSEARCH Then

shBook2.Range("C" & j & ",R" & j & ",X" & j & ",G" & j).Copy _
shBook1.Range("O" & i)
Exit For
End If
Next j
Next i
Application.ScreenUpdating = True