Optimize and Speed Up VBA Code

[Dokat]

Hi,

Can someone help me optimiz and speed up the run time for below code? It's taking long to calculate subtract, divide and %?

Sub MathL4WMANUFACTURER()
    Dim i As Integer
    Dim condition As Range
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With Sheets("HDD")
        For i = 16 To 26
            .Cells(i, 16) = .Cells(i, 14) - .Cells(i, 15)

            If .Cells(i, 15) <> 0 Then
                .Cells(i, 17) = .Cells(i, 14) / .Cells(i, 15) - 1
            End If
         
            If .Range("N16") <> 0 Then
                .Cells(i, 18) = .Cells(i, 14) / .Range("N16") * 100
            End If
       
            If .Range("O16") <> 0 Then
                .Cells(i, 19) = .Cells(i, 15) / .Range("O16") * 100
            End If
       
            .Cells(i, 20) = .Cells(i, 18) - .Cells(i, 19)
       
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Next i
    End With

End Sub

Thanks

 

[Luke M]

Don't turn screen updating on till you're all done. You can also call out the specific property of the cell you want (Value), so compiler doesn't spend time figuring it out.

Sub MathL4WMANUFACTURER()
    Dim i As Integer
    Dim condition As Range
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With Sheets("HDD")
        For i = 16 To 26
            .Cells(i, 16).Value = .Cells(i, 14).Value - .Cells(i, 15).Value


            If .Cells(i, 15).Value <> 0 Then
                .Cells(i, 17).Value = .Cells(i, 14).Value / .Cells(i, 15).Value - 1
            End If
         
            If .Range("N16").Value <> 0 Then
                .Cells(i, 18).Value = .Cells(i, 14).Value / .Range("N16").Value * 100
            End If
       
            If .Range("O16").Value <> 0 Then
                .Cells(i, 19).Value = .Cells(i, 15).Value / .Range("O16").Value * 100
            End If
       
            .Cells(i, 20).Value = .Cells(i, 18).Value - .Cells(i, 19).Value       
       
        Next i
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Dokat]

Thank you. Speed improved significantly

 

[p45cal]

Another couple for you to test:

Sub blah()
With Range("P16:T26")
  .Columns(1).FormulaR1C1 = "=RC[-2]-RC[-1]"
  .Columns(2).FormulaR1C1 = "=IFERROR(RC[-3]/RC[-2]-1,"""")"
  .Columns(3).FormulaR1C1 = "=IFERROR(RC[-4]/R16C14 * 100,"""")"
  .Columns(4).FormulaR1C1 = "=IFERROR(RC[-4]/R16C15*100,"""")"
  .Columns(5).FormulaR1C1 = "=IFERROR(RC[-2]-RC[-1],"""")"
  .Value = .Value
End With
End Sub

Sub blah2()
SceVals = Range("N16:O26").Value
N16 = SceVals(1, 1) 'silly name for a variable - I know!
O16 = SceVals(1, 2) 'likewise silly.
rcount = UBound(SceVals)
ReDim Res(1 To rcount, 1 To 5)
For c = 1 To 5
  Select Case c
    Case 1
      For r = 1 To rcount
        Res(r, c) = SceVals(r, 1) - SceVals(r, 2)
      Next r
    Case 2
      For r = 1 To rcount
        If SceVals(r, 1) <> 0 Then Res(r, c) = SceVals(r, 1) / SceVals(r, 2) - 1
      Next r
    Case 3
      If N16 <> 0 Then
        For r = 1 To rcount
          Res(r, c) = SceVals(r, 1) / N16 * 100
        Next r
      End If
    Case 4
      If O16 <> 0 Then
        For r = 1 To rcount
          Res(r, c) = SceVals(r, 2) / O16 * 100
        Next r
      End If
    Case 5
      For r = 1 To rcount
        Res(r, c) = Res(r, 3) - Res(r, 4)
      Next r
  End Select
Next c
Range("P16").Resize(UBound(Res), UBound(Res, 2)) = Res
End Sub

You can try adding Application.screenupdating = False/True to blah, it's not worth it for blah2.
In Case 5 in blah2, if you know you don't need to calculate the difference of those two columns because (say) either of cells N16 and O16 are zero, we can avoid running that loop altogether. This would help if there are a really large number of rows to process.