Sorry... one more thing to add. Turn off calculation and screen updating...

Sub Generate()
Dim s As Date
Dim f As Date
Dim t As Long
Dim DataPart As Range 'Explict type
Dim rngSource As Range
Dim rngToSearch As Range
Dim rng As Range

s = Now


With Sheets("Report")
Set rngSource = .Range(.Range("A2"), .Cells(Rows.Count, "A").End(xlUp))
Set rngToSearch = .Range("AHpart")
End With

with Application
..Calculation = xlCalculationManual
..screenupdating = false
end with
For Each rng In rngSource
Set DataPart = rngToSearch.Find(What:=rng.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
If Not DataPart Is Nothing Then
rng.Offset(0, 2).Value = DataPart.Offset(0, 1).Value
End If
Next rng
with Application
..Calculation = xlCalculationAutomatic
..screenupdating = false
end with

f = Now
t = DateDiff("s", s, f)
MsgBox (t)

End Sub
--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

You can try this...

Sub Generate()
Dim s As Date
Dim f As Date
Dim t As Long
Dim DataPart As Range 'Explict type
Dim rngSource As Range
Dim rngToSearch As Range
Dim rng As Range

s = Now


With Sheets("Report")
Set rngSource = .Range(.Range("A2"), .Cells(Rows.Count, "A").End(xlUp))
Set rngToSearch = .Range("AHpart")
End With

For Each rng In rngSource
Set DataPart = rngToSearch.Find(What:=rng.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
If Not DataPart Is Nothing Then
rng.Offset(0, 2).Value = DataPart.Offset(0, 1).Value
End If
Next rng

f = Now
t = DateDiff("s", s, f)
MsgBox (t)

End Sub

There are a couple of things it does. One it does not use type Object. That
will be slower than using Range as the declaration. It removes the counters
as they are not necessary. It declares both the source range and search range
explicitly at the beginning of the process so that no evaluations need to be
done. Your Wend loop needs to be evaluated each iteration through the loop.
Your With Range("AHpart") is evaluted each time the loop is executed. I have
no idea what your Data variable is supposed to do as it just adds 0. No
gurantees but this code should be a bit faster...
--
HTH...

Jim Thomlinson


"Aaron" wrote:

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?