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?

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?

Hi

Try putting
Application.ScreenUpdating = False

at the start, and

Application.ScreenUpdating = True

just before the MsgBox, might help

hth

Keith

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?

Find a formula that works to extract the correct data, then insert that formula in the third column
(matching your table) using the macro. No looping involved. Something like this one line:

Range("A2", Range("A2").End(xlDown)).Offset(0, 2).Formula = "=VLOOKUP(A2,AHPart,2,FALSE)"

You could then convert that to values if you wanted.

HTH,
Bernie
MS Excel MVP


"Aaron" wrote in message
...
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?

Your first post was dead even with mine at 22 seconds, the added code from
your second post shaved a second off. I guess 21 seconds is the best I can
do.

Thanks for your help

"Jim Thomlinson" wrote:

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?

for some reason doing it your way added a second, but doing it as Jim
sugested shaved a second, not sure why.

"Keith74" wrote:

Hi

Try putting
Application.ScreenUpdating = False

at the start, and

Application.ScreenUpdating = True

just before the MsgBox, might help

hth

Keith

Wow, from 22 seconds to 8 seconds. So is that a rule? I mean, if I want to
populate a cell should I only use VBA if no formula exists?


"Bernie Deitrick" wrote:

Find a formula that works to extract the correct data, then insert that formula in the third column
(matching your table) using the macro. No looping involved. Something like this one line:

Range("A2", Range("A2").End(xlDown)).Offset(0, 2).Formula = "=VLOOKUP(A2,AHPart,2,FALSE)"

You could then convert that to values if you wanted.

HTH,
Bernie
MS Excel MVP


"Aaron" wrote in message
...
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?

Aaron,

Generally, the more native Excel functionality you use, and the less
looping, the faster your code will run. Well-written worksheet formulas
trump almost any VBA code - I'm sure Harlan will jump in here and prove me
wrong, so I will add the caveat "in most cases." And, frankly, I'm surprised
that it took 8 seconds, though that could be impacted by other formulas,
etc. The more experience you have in using Excel, the better you can make
those decisions. One of the most commonly done tasks (deleting rows based
on a value) is almost always faster after a sort than by looping through,
for example.

But, of course there are cases where the function just doesn't exist, or is
easier to implement by using a User-Defined-Function (UDF). A lot depends
on the circumstances, the requirements, the data layout, the skill of the
coder, etc.

Bernie


"Aaron" wrote in message
...
Wow, from 22 seconds to 8 seconds. So is that a rule? I mean, if I want
to
populate a cell should I only use VBA if no formula exists?


"Bernie Deitrick" wrote:

Find a formula that works to extract the correct data, then insert that
formula in the third column
(matching your table) using the macro. No looping involved. Something
like this one line:

Range("A2", Range("A2").End(xlDown)).Offset(0, 2).Formula =
"=VLOOKUP(A2,AHPart,2,FALSE)"

You could then convert that to values if you wanted.

HTH,
Bernie
MS Excel MVP


"Aaron" wrote in message
...
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?