Is there a way to speed up this SumIf VBA code?

Darranimo

Board Regular
Joined
Jan 19, 2022
Messages
52
Office Version
  1. 365
Platform
  1. Windows
I have some code summing by project cost codes and then dumping those totals at the end of a report. However, it runs rather slowly and I'm looking for efficiencies to speed it up. That piece of the code looks like this:

VBA Code:
Range("J" & lrw + 4) = Application.WorksheetFunction.SumIf(cod, "1310*", act)
    Range("J" & lrw + 5) = Application.WorksheetFunction.SumIf(cod, "1313*", act)
    Range("J" & lrw + 6) = Application.WorksheetFunction.SumIf(cod, "1320*", act)
    Range("J" & lrw + 7) = Application.WorksheetFunction.SumIf(cod, "1321*", act)
    Range("J" & lrw + 8) = Application.WorksheetFunction.SumIf(cod, "1330*", act)
    Range("J" & lrw + 9) = Application.WorksheetFunction.SumIf(cod, "1340*", act)
    Range("J" & lrw + 10) = Application.WorksheetFunction.SumIf(cod, "1350*", act)
    Range("J" & lrw + 11) = Application.WorksheetFunction.SumIf(cod, "1360*", act)
    Range("J" & lrw + 12) = Application.WorksheetFunction.SumIf(cod, "1361*", act)
    Range("J" & lrw + 13) = Application.WorksheetFunction.SumIf(cod, "1370*", act)
    Range("J" & lrw + 14) = Application.WorksheetFunction.SumIf(cod, "1380*", act)
    Range("J" & lrw + 15) = Application.WorksheetFunction.SumIf(cod, "1381*", act)
    Range("J" & lrw + 16) = Application.WorksheetFunction.SumIf(cod, "1805*", act)
    Range("J" & lrw + 17) = Application.WorksheetFunction.SumIf(cod, "183*", act)
    Range("J" & lrw + 18) = Application.WorksheetFunction.sum(Range("J" & lrw + 4, "J" & lrw + 18))

Here is the VBA script in it's entirety:

VBA Code:
Sub Run()
    Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim amt As Range
    Dim act As Range
    Dim prj As Range
    Dim cod As Range
    Dim tbl As Range
    Dim lrw As Long
    Dim lbl As Range
    Dim sum As Range
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Lot Latest Estimate")
    Set sum = Worksheets("format").Range("Summary")
    Set lbl = Worksheets("Format").Range("Labels")
    lrw = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row

    
    ws.AutoFilterMode = False
    ActiveWindow.FreezePanes = False
    lbl.Copy Range("A8")
    Range("A:A").ColumnWidth = 15
    Range("F:K").ColumnWidth = 15
    

    Set tbl = Range("A10", "K" & lrw - 1)
    Set amt = Range("F10", "K" & lrw - 1)
    Set cod = Range("A11", "A" & lrw - 1)
    Set act = Range("H11", "H" & lrw - 1)
    Set prj = Range("J11", "J" & lrw - 1)
    tbl.AutoFilter
    
    For Each rng In amt
        If Right(rng.Value, 1) = "*" Then rng.Value = Left(rng.Value, Len(rng.Value) - 1)
        If rng.Value = "" Then rng.Value = 0
    Next
        
    Range("A" & lrw, "B" & lrw).ClearContents
    Range("D" & lrw, "E" & lrw).ClearContents
    Range("A11", "K11").ClearContents
    
    sum.Copy Range("H" & lrw + 3)
    
        
    Range("J" & lrw + 4) = Application.WorksheetFunction.SumIf(cod, "1310*", act)
    Range("J" & lrw + 5) = Application.WorksheetFunction.SumIf(cod, "1313*", act)
    Range("J" & lrw + 6) = Application.WorksheetFunction.SumIf(cod, "1320*", act)
    Range("J" & lrw + 7) = Application.WorksheetFunction.SumIf(cod, "1321*", act)
    Range("J" & lrw + 8) = Application.WorksheetFunction.SumIf(cod, "1330*", act)
    Range("J" & lrw + 9) = Application.WorksheetFunction.SumIf(cod, "1340*", act)
    Range("J" & lrw + 10) = Application.WorksheetFunction.SumIf(cod, "1350*", act)
    Range("J" & lrw + 11) = Application.WorksheetFunction.SumIf(cod, "1360*", act)
    Range("J" & lrw + 12) = Application.WorksheetFunction.SumIf(cod, "1361*", act)
    Range("J" & lrw + 13) = Application.WorksheetFunction.SumIf(cod, "1370*", act)
    Range("J" & lrw + 14) = Application.WorksheetFunction.SumIf(cod, "1380*", act)
    Range("J" & lrw + 15) = Application.WorksheetFunction.SumIf(cod, "1381*", act)
    Range("J" & lrw + 16) = Application.WorksheetFunction.SumIf(cod, "1805*", act)
    Range("J" & lrw + 17) = Application.WorksheetFunction.SumIf(cod, "183*", act)
    Range("J" & lrw + 18) = Application.WorksheetFunction.sum(Range("J" & lrw + 4, "J" & lrw + 18))

    Range("K" & lrw + 4) = Application.WorksheetFunction.SumIf(cod, "1310*", prj)
    Range("K" & lrw + 5) = Application.WorksheetFunction.SumIf(cod, "1313*", prj)
    Range("K" & lrw + 6) = Application.WorksheetFunction.SumIf(cod, "1320*", prj)
    Range("K" & lrw + 7) = Application.WorksheetFunction.SumIf(cod, "1321*", prj)
    Range("K" & lrw + 8) = Application.WorksheetFunction.SumIf(cod, "1330*", prj)
    Range("K" & lrw + 9) = Application.WorksheetFunction.SumIf(cod, "1340*", prj)
    Range("K" & lrw + 10) = Application.WorksheetFunction.SumIf(cod, "1350*", prj)
    Range("K" & lrw + 11) = Application.WorksheetFunction.SumIf(cod, "1360*", prj)
    Range("K" & lrw + 12) = Application.WorksheetFunction.SumIf(cod, "1361*", prj)
    Range("K" & lrw + 13) = Application.WorksheetFunction.SumIf(cod, "1370*", prj)
    Range("K" & lrw + 14) = Application.WorksheetFunction.SumIf(cod, "1380*", prj)
    Range("K" & lrw + 15) = Application.WorksheetFunction.SumIf(cod, "1381*", prj)
    Range("K" & lrw + 16) = Application.WorksheetFunction.SumIf(cod, "1805*", prj)
    Range("K" & lrw + 17) = Application.WorksheetFunction.SumIf(cod, "183*", prj)
    Range("K" & lrw + 18) = Application.WorksheetFunction.sum(Range("K" & lrw + 4, "K" & lrw + 18))

    lrw = Cells(Rows.Count, "K").End(xlUp).Row
    ws.PageSetup.PrintArea = ActiveSheet.Range("A1", "K" & lrw).Address
    
    Range("A11").Select
    ActiveWindow.FreezePanes = True
    Application.ScreenUpdating = True
    

End Sub

Any help is greatly appreciated!!!
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Hello, you could share your file with some data. Just a sample of data to run your macro.
How many records does your original file have?

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0

Forum statistics

Threads
1,215,005
Messages
6,122,661
Members
449,091
Latest member
peppernaut

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