Code running very slow takes 15 seconds, need an alternative to make it faster

E

Excelpromax123

Board Regular
Joined
Sep 2, 2021
Messages
167
Office Version
  1. 2010
Platform
  1. Windows
I have used this code to replace sumif function but the speed is also over 15 seconds. Anyone have a faster solution? Please help me. Sincerely thank

VBA Code: 
Sub TestSumIf()
Dim a As Long, b As Long, c As Long, d As Long, F As Long, y As Long, x1 As Long
For x1 = 5 To 10000
    a = Application.WorksheetFunction.SumIf(Sheets("data").Range("C4:C10003"), Range("B" & x1), Sheets("data").Range("H4:H10003"))
    b = Application.WorksheetFunction.SumIf(Sheets("data").Range("BH2:BH10000"), Range("B" & x1), Sheets("data").Range("BI2:BI10000"))
    c = Application.WorksheetFunction.SumIf(Sheets("data").Range("BM2:BM10000"), Range("B" & x1), Sheets("data").Range("BN2:BN10000"))
    d = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    e = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    F = Application.WorksheetFunction.SumIf(Sheets("data").Range("J5:J10004"), Range("B" & x1), Sheets("data").Range("K5:K10004"))
    y = a + b - c + d - e + F
    Range("d" & x1) = y
Next x1

MsgBox ("OK")
End Sub
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Try this
VBA Code: 
Sub TestSumIf()
Dim a As Long, b As Long, c As Long, d As Long, F As Long, y As Long, x1 As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For x1 = 5 To 10000
    a = Application.WorksheetFunction.SumIf(Sheets("data").Range("C4:C10003"), Range("B" & x1), Sheets("data").Range("H4:H10003"))
    b = Application.WorksheetFunction.SumIf(Sheets("data").Range("BH2:BH10000"), Range("B" & x1), Sheets("data").Range("BI2:BI10000"))
    c = Application.WorksheetFunction.SumIf(Sheets("data").Range("BM2:BM10000"), Range("B" & x1), Sheets("data").Range("BN2:BN10000"))
    d = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    e = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    F = Application.WorksheetFunction.SumIf(Sheets("data").Range("J5:J10004"), Range("B" & x1), Sheets("data").Range("K5:K10004"))
    y = a + b - c + d - e + F
    Range("d" & x1) = y
Next x1

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox ("OK")
End Sub
 
Upvote 0
Thee 2 lines produce the same sum :
VBA Code: 
 d = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
 e = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))

Then in calculating y, you have y=+d-e
 
Upvote 0
Zot said:
Try this
VBA Code: 
Sub TestSumIf()
Dim a As Long, b As Long, c As Long, d As Long, F As Long, y As Long, x1 As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For x1 = 5 To 10000
    a = Application.WorksheetFunction.SumIf(Sheets("data").Range("C4:C10003"), Range("B" & x1), Sheets("data").Range("H4:H10003"))
    b = Application.WorksheetFunction.SumIf(Sheets("data").Range("BH2:BH10000"), Range("B" & x1), Sheets("data").Range("BI2:BI10000"))
    c = Application.WorksheetFunction.SumIf(Sheets("data").Range("BM2:BM10000"), Range("B" & x1), Sheets("data").Range("BN2:BN10000"))
    d = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    e = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    F = Application.WorksheetFunction.SumIf(Sheets("data").Range("J5:J10004"), Range("B" & x1), Sheets("data").Range("K5:K10004"))
    y = a + b - c + d - e + F
    Range("d" & x1) = y
Next x1

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox ("OK")
End Sub
Click to expand...

I tried and the speed is very slow like the original. I need an array code to process
 
Upvote 0
footoo said:
Thee 2 lines produce the same sum :
VBA Code: 
 d = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
 e = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))

Then in calculating y, you have y=+d-e
Click to expand...
This is just my example. Actually D and E 2 different addresses. I need 1 Sub array. Can you help me
 
Upvote 0
Zot said:
Try this
VBA Code: 
Sub TestSumIf()
Dim a As Long, b As Long, c As Long, d As Long, F As Long, y As Long, x1 As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For x1 = 5 To 10000
    a = Application.WorksheetFunction.SumIf(Sheets("data").Range("C4:C10003"), Range("B" & x1), Sheets("data").Range("H4:H10003"))
    b = Application.WorksheetFunction.SumIf(Sheets("data").Range("BH2:BH10000"), Range("B" & x1), Sheets("data").Range("BI2:BI10000"))
    c = Application.WorksheetFunction.SumIf(Sheets("data").Range("BM2:BM10000"), Range("B" & x1), Sheets("data").Range("BN2:BN10000"))
    d = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    e = Application.WorksheetFunction.SumIf(Sheets("data").Range("BW102:BW6001"), Range("B" & x1), Sheets("data").Range("BX102:BX6001"))
    F = Application.WorksheetFunction.SumIf(Sheets("data").Range("J5:J10004"), Range("B" & x1), Sheets("data").Range("K5:K10004"))
    y = a + b - c + d - e + F
    Range("d" & x1) = y
Next x1

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

MsgBox ("OK")
End Sub
Click to expand...
I need a code like the SUMif function to put in the processing array for fast
1640873351676.png
 
Upvote 0
Your code and sample is not related, right? I was wondering how fast would it be just using subtotal function. For the Excel sample above, this is what I would do (adapt it to your code).

VBA Code: 
Sub Test()

Dim cell As Range, rngName As Range, rngData As Range, rngQty As Range
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = ActiveWorkbook.Sheets("Sheet1") ' Change if required
Set rngName = ws.Range("B3", "B28")
Set rngData = ws.Range("G2", "G28")
Set rngQty = ws.Range("H2", "H28")

For Each cell In rngName
    rngData.AutoFilter
    rngData.AutoFilter Field:=1, Criteria1:=cell
    cell.Offset(0, 1) = Application.WorksheetFunction.Subtotal(9, rngQty)
Next
rngData.AutoFilter

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
258
ItalianPlatinum
I
TAPS_MikeDion
  • Question
Help needed with making a faster, more efficient VBA code
2 3
Replies
21
Views
1K
TAPS_MikeDion
TAPS_MikeDion
Guna13
  • Question
Help to Optimize Macro Code for Faster Performance
Replies
0
Views
752
Guna13
Guna13
M
  • Question
Help making code faster
Replies
3
Views
312
michaelsmith559
M
N
  • Solved
How could I make VBA code faster
Replies
3
Views
471
offthelip
O

Forum statistics

Threads
1,214,985
Messages
6,122,606
Members
449,089
Latest member
Motoracer88

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top