Code too slow (looping find to match data)
This code is the work horse of many of my programs but I wish it would run
faster. It basically runs through a list of values one at a time and looks
them up on a larger list and returns some coresponding data from the larger
list.
Sub Generate()
Dim s As Date
Dim f As Date
Dim t As Long
Dim rptr As Long
Dim data As Long
Dim DataPart As Object
Dim RptPrt As String
s = now
rptr = 2
data = 0
Sheets("Report").Select
While Cells(rptr, 1) < ""
RptPrt = Cells(rptr, 1)
'If WorksheetFunction.CountIf(Range("AHPart"), RptPrt) 0 Then
With Range("AHpart")
Set DataPart = .Find(RptPrt)
'Set DataPart = .Find(What:=RptPrt, After:=.Cells(1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End With
If Not DataPart Is Nothing Then
data = data + DataPart.Offset(0, 1).Value
Cells(rptr, 3) = data
rptr = rptr + 1
data = 0
Else
rptr = rptr + 1
End If
'Else
'rptr = rptr + 1
'End If
Wend
f = now
t = DateDiff("s", s, f)
MsgBox (t)
End Sub
If I use the countif or the explicit find the code runs even slower. AHPart
is a dynamic range on the large list so it is only as long as it needs to be.
Can this be faster?
|