Look up & past value

[Les Stout]

Hi all, i was kindly helped by Tom with the code below & the Progress
bar code. It works really great on small worksheets up to 5,000 rows,
however i processed a worksheet with up 15,000 rows of information and
it took ages,(3 1/2 mins), at times they can be 60,000 rows long !!!.
Yes the counter makes a difference but not really anything to moan
about. Is there anyway that this can be sped up or would it be quicker
to copy the entire column from one workbook to the other, of Variable
names ?


Sub Lookups()

Dim myLookUpRng As Range
Dim i As Long
Dim NumRows As Long
Dim LastRow As Long
Range("D4").Select
With Workbooks(SuppFileNameC).Worksheets(SheetName)
Set myLookUpRng = .Range("D:N")
End With
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
' MsgBox "This Recon has : " & LastRow & " Rows of data - start"
NumRows = LastRow - 3
For i = 4 To LastRow
Cells(i, "L").Value = Application.VLookUp(Cells(i, "D").Value, _
myLookUpRng, 9, 0)
Cells(i, "L").Value = Cells(i, "L").Value
With Cells(i, "L")
.Font.ColorIndex = 3
.Font.Bold = True
End With
Cells(i, "M").Value = Application.VLookUp(Cells(i, "D").Value, _
myLookUpRng, 10, 0)
Cells(i, "M").Value = Cells(i, "M").Value
UpdateProgressV (i - 3) / NumRows
Next i
Range("A4").Select
On Error Resume Next
CloseForm2
End Sub


Les Stout

 

[Tom Ogilvy]

Try this:

Sub LookupsAA()

Dim myLookUpRng As Range
Dim i As Long
Dim NumRows As Long
Dim LastRow As Long
Range("D4").Select
With Workbooks(SuppFileNameC).Worksheets(SheetName)
Set myLookUpRng = .Range("D:N")
End With
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
' MsgBox "This Recon has : " & LastRow & " Rows of data - start"
NumRows = LastRow - 3
With Cells(4,L).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",9,0)"
.Value = .Value
End With
With Cells(4,M).Resize(NumRows)
.Formula = "=Vlookup(D4," & _
myLookupRng.Address(1,1,xlA1,True) & ",10,0)"
.Value = .Value
End with
With Cells(4,"L").Resize(NumRows)
.Font.ColorIndex = 3
.Font.bold = True
End With
Range("A4").Select
CloseForm2
End Sub

 

[Les Stout]

Thanks Tom, it is home time here and the frosty is calling... will be in
tomorrow so will try it then..

Great weekend and thanks again for all the help.

best regards,

Les Stout