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" <(E-Mail Removed)> wrote in message
news:48AE0EE2-68A8-456D-8D63-(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
> news:48AE0EE2-68A8-456D-8D63-(E-Mail Removed)...
> > 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" <(E-Mail Removed)> wrote in message
news:BC92984F-B5F1-42F1-B3A8-(E-Mail Removed)...
> 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" <(E-Mail Removed)> wrote in message
>> news:48AE0EE2-68A8-456D-8D63-(E-Mail Removed)...
>> > 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?
>>
>>
>>