Custom VBA took 0.0625 sec is it too slow?
 

Hi
I have abt 220 rows and 25 columns to fill up with this function
and i tested the speed abt 0.0625 sec which means it takes up to 5.5min to
run finish the whole thing
Anyway to make it faster ?

i have a table consist of 5 impt fields (PO#,PartNo,POQty,DueDate,POBalQty)
My Function call in 2 values(PartNo and EDate)
EDate = a Monday

I need to display whether during the week i have
- how many dely Or
- how many POQty Or
- how many dely and POBal

Anyway to make it faster ?

Function calQty(PartNo As String, EDate)

Dim PO, Bal, Dely, POtemp, Baltemp, Delytemp

Worksheets("PO").Activate
NextRow = Application.WorksheetFunction.CountA(Worksheets("P O").Range("A:A"))
PO = 0
Bal = 0
Dely = 0
POtemp = 0
Baltemp = 0
Delytemp = 0

For A = 1 To NextRow
If Worksheets("PO").Cells(A, 3) = PartNo And Worksheets("PO").Cells(A,
6) < EDate + 7 And Worksheets("PO").Cells(A, 6) = EDate Then
x = A
If Worksheets("PO").Cells(x, 10) = 0 Then
Delytemp = Worksheets("PO").Cells(x, 5)
Dely = Dely + Delytemp
ElseIf Worksheets("PO").Cells(x, 10) = Worksheets("PO").Cells(x,
5) Then
POtemp = Worksheets("PO").Cells(x, 5)
PO = PO + POtemp
Else
Baltemp = Worksheets("PO").Cells(x, 10)
Bal = Bal + Baltemp
End If
End If
Next A

Bal = Bal + PO

If Bal = 0 Then
calQty = "D " & Dely
ElseIf Dely = 0 Then
calQty = PO
Else
calQty = "D " & Dely & " B " & Bal
End If

If Bal = 0 And Dely = 0 Then
calQty = 0
End If
End Function

Custom VBA took 0.0625 sec is it too slow?
 

Try setting the Calculations to manual before starting your routine and
setting them back to the old value after the routine. Do the same for
ScreenUPdating and EnableEvents.(Enable events is required only if there is a
change event or selection change event on that sheet)

I typically use code such as follows
Dim bOldScreenUpdating as boolean
Dim vOldCalculation as Variant
Dim bOldEnableEvents as boolean
bOldScreenUpdating=Application.ScreenUpdating
vOldCalculation=Application.Calculation
bOldEnableEvents=Application.EnableEvents
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
Application.EnableEvents=False

' Here all my code

Application.ScreenUpdating=bOldScreenUpdating
Application.Calculation=vOldCalculation
Application.EnableEvents=bOldEnableEvents

Alok Joshi


"SeeKY" wrote:

Hi
I have abt 220 rows and 25 columns to fill up with this function
and i tested the speed abt 0.0625 sec which means it takes up to 5.5min to
run finish the whole thing
Anyway to make it faster ?

i have a table consist of 5 impt fields (PO#,PartNo,POQty,DueDate,POBalQty)
My Function call in 2 values(PartNo and EDate)
EDate = a Monday

I need to display whether during the week i have
- how many dely Or
- how many POQty Or
- how many dely and POBal

Anyway to make it faster ?

Function calQty(PartNo As String, EDate)

Dim PO, Bal, Dely, POtemp, Baltemp, Delytemp

Worksheets("PO").Activate
NextRow = Application.WorksheetFunction.CountA(Worksheets("P O").Range("A:A"))
PO = 0
Bal = 0
Dely = 0
POtemp = 0
Baltemp = 0
Delytemp = 0

For A = 1 To NextRow
If Worksheets("PO").Cells(A, 3) = PartNo And Worksheets("PO").Cells(A,
6) < EDate + 7 And Worksheets("PO").Cells(A, 6) = EDate Then
x = A
If Worksheets("PO").Cells(x, 10) = 0 Then
Delytemp = Worksheets("PO").Cells(x, 5)
Dely = Dely + Delytemp
ElseIf Worksheets("PO").Cells(x, 10) = Worksheets("PO").Cells(x,
5) Then
POtemp = Worksheets("PO").Cells(x, 5)
PO = PO + POtemp
Else
Baltemp = Worksheets("PO").Cells(x, 10)
Bal = Bal + Baltemp
End If
End If
Next A

Bal = Bal + PO

If Bal = 0 Then
calQty = "D " & Dely
ElseIf Dely = 0 Then
calQty = PO
Else
calQty = "D " & Dely & " B " & Bal
End If

If Bal = 0 And Dely = 0 Then
calQty = 0
End If
End Function

Custom VBA took 0.0625 sec is it too slow?
 

untested,
but rewritten...

I've given all variables a type.
instead of calling the complete worksheets("PO").cells again and again
i set a range, then loop its rows
i use a with/end with
I've nested the if's so it can escape as soon as the first test fails

That said...
if as you say it is called fairly often, it is probably faster
to NOT do this in VBA but use array functions like sumproduct

OR sort your PO table by partnumber...
and rewrite your function to quickly locate the first matching PartNo
and exit as soon as the partno changes


Function calQty(ByVal PartNo As String, ByVal EDate As Double) As String

Dim rngPOs As Range
Dim rngRow As Range
Dim dsumP As Double
Dim dsumB As Double
Dim dsumD As Double

With Worksheets("PO")
Set rngPOs = .Range("A1", .Range("A65536").End(xlUp)).Resize(, 10)
End With

For Each rngRow In rngPOs.Rows
With rngRow
If .Cells(1, 3).Value = PartNo Then
If .Cells(1, 6).Value2 < EDate + 7 Then
If .Cells(1, 6).Value2 <= EDate Then
Select Case .Cells(1, 10).Value
Case 0, Empty
dsumD = dsumD + .Cells(1, 5).Value2
Case .Cells(1, 5).Value
dsumP = dsumP + .Cells(1, 5).Value2
Case Else
dsumB = dsumB + .Cells(1, 10).Value2
End Select
End If
End If
End If
End With
Next

dsumB = dsumB + dsumP
If dsumB = 0 And dsumD = 0 Then
calQty = "0"
ElseIf dsumB = 0 Then
calQty = "D " & dsumD
ElseIf dsumD = 0 Then
calQty = dsumP
Else
calQty = "D " & dsumD & " B " & dsumB
End If

End Function



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


SeeKY wrote :

Hi
I have abt 220 rows and 25 columns to fill up with this function
and i tested the speed abt 0.0625 sec which means it takes up to
5.5min to run finish the whole thing
Anyway to make it faster ?

i have a table consist of 5 impt fields
(PO#,PartNo,POQty,DueDate,POBalQty) My Function call in 2
values(PartNo and EDate) EDate = a Monday

I need to display whether during the week i have
- how many dely Or
- how many POQty Or
- how many dely and POBal

Anyway to make it faster ?

Function calQty(PartNo As String, EDate)

Dim PO, Bal, Dely, POtemp, Baltemp, Delytemp

Worksheets("PO").Activate
NextRow =
Application.WorksheetFunction.CountA(Worksheets("P O").Range("A:A"))
PO = 0 Bal = 0
Dely = 0
POtemp = 0
Baltemp = 0
Delytemp = 0

For A = 1 To NextRow
If Worksheets("PO").Cells(A, 3) = PartNo And
Worksheets("PO").Cells(A, 6) < EDate + 7 And
Worksheets("PO").Cells(A, 6) = EDate Then x = A
If Worksheets("PO").Cells(x, 10) = 0 Then
Delytemp = Worksheets("PO").Cells(x, 5)
Dely = Dely + Delytemp
ElseIf Worksheets("PO").Cells(x, 10) =
Worksheets("PO").Cells(x, 5) Then
POtemp = Worksheets("PO").Cells(x, 5)
PO = PO + POtemp
Else
Baltemp = Worksheets("PO").Cells(x, 10)
Bal = Bal + Baltemp
End If
End If
Next A

Bal = Bal + PO

If Bal = 0 Then
calQty = "D " & Dely
ElseIf Dely = 0 Then
calQty = PO
Else
calQty = "D " & Dely & " B " & Bal
End If

If Bal = 0 And Dely = 0 Then
calQty = 0
End If
End Function