CODEWITHSUNDEEP
excelvba
Kurt
Kurt

Reputation: 135

This Worksheet Sum Function is very slow - Ideas to speed it up?

I have the following sum function that requires lots of time to give an output:

Sub Sum_multiple_columns()
    Dim ws As Worksheet
    Dim destinationLastRow As Long, i As Long
    Dim TotalCoverage As Double
    Dim rng As Range, MyResultsRng As Range
    Dim cell As Range
    
    Const FirstCol As Long = 12 ' "L"
    Const LastCol As Long = 24 ' "X"
    Const TotalCoverageColumn As Long = 9
    Set ws = ThisWorkbook.Worksheets("Master")
    destinationLastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    For i = 5 To destinationLastRow
        Set MyResultsRng = ws.Range("K" & i)
        For Each cell In MyResultsRng
            Set rng = ws.Range(ws.Cells(i, FirstCol), ws.Cells(i, LastCol))
            TotalCoverage = Application.WorksheetFunction.Sum(rng.Value)
            With MyResultsRng
                .Value = TotalCoverage
                .HorizontalAlignment = xlCenter
                .Font.Color = RGB(40, 101, 156)
                .Font.Bold = True
                .Font.Size = 9
                .Font.Name = "Calibri"
                .NumberFormat = "0.00"
             End With
        Next cell
    Next i
End Sub

In your opinion, how could I speed up this code which is intented to sum values from column L to X and put the result into column K for every row in the list.

Thank you

Upvotes: 0

Views: 231

Answers (2)

Chronocidal
Chronocidal

Reputation: 7951

Okay, let's just skip the loops entirely.

Sub Sum_multiple_columns()
    Const FirstCol As Long = 12 ' "L"
    Const LastCol As Long = 24 ' "X"
    Const OutputColumn As Long = 11 ' "K"

    Dim ws As Worksheet, LastRow As Long, OutputRange As Range
    Dim FirstSumRow As Range, FirstSumTarget As String

    Set ws = ThisWorkbook.Worksheets("Master")
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    Set OutputRange = ws.Range(ws.Cells(5, OutputColumn), ws.Cells(LastRow, OutputColumn))
    Set FirstSumRow = ws.Range(ws.Cells(5, FirstCol), ws.Cells(5, LastCol))
    FirstSumTarget = FirstSumRow.Address(False, True, xlA1, False)

    Dim tmpCalc AS xlCalculation: tmpCalc = Application.Calculation 'Save setting
        Application.Calculation = xlCalculationManual 'Makes things slightly faster
    
    With OutputRange
        .Formula = "=SUM(" & FirstSumTarget  & ")" 'This will fill down automatically
        .Calculate 'Needed because Calculation is currently manual
        .Value = .Value 'Convert the formulae into flat values
        
        .HorizontalAlignment = xlCenter
        .Font.Color = RGB(40, 101, 156)
        .Font.Bold = True
        .Font.Size = 9
        .Font.Name = "Calibri"
        .NumberFormat = "0.00"
    End With
    
    Application.Calculation = tmpCalc 'Restore setting saved earlier
End Sub

Upvotes: 0

FaneDuru
FaneDuru

Reputation: 42236

Please, try the next way:

Sub Sum_multiple_columns()
    Dim ws As Worksheet, destinationLastRow As Long, i As Long
    
    Const FirstCol As Long = 12 ' "L"
    Const LastCol As Long = 24 ' "X"
    Const TotalCoverageColumn As Long = 9
    
    Set ws = ThisWorkbook.Worksheets("Master")
    destinationLastRow = ws.Range("A" & rows.count).End(xlUp).row
    For i = 5 To destinationLastRow
        ws.Range("K" & i).Value = Application.WorksheetFunction.Sum(ws.Range(ws.cells(i, FirstCol), ws.cells(i, LastCol)))
    Next i
    With ws.Range("K5:K" & destinationLastRow)
        .HorizontalAlignment = xlCenter
        .Font.color = RGB(40, 101, 156)
        .Font.Bold = True
        .Font.Size = 9
        .Font.Name = "Calibri"
        .NumberFormat = "0.00"
    End With
End Sub

Not tested, but it should work if I did not miss anything...

Upvotes: 1

Related Questions