Macro Speed Optimization

[Dokat]

Hi,

I have below macro code that runs extremely slow. i was wondering if there is a way to optimize and speed up the run time. Thanks

Sub MathYTDFORMBRANDAC()


    Dim i As Integer, x As Integer, z As Integer, h As Integer, f As Integer, t As Integer
           
    Dim condition As Range
     
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
   
    With Sheets("AC")
   
       
        For i = 74 To 83
       
            .Cells(i, 30).Value = .Cells(i, 28).Value - .Cells(i, 29).Value

            If .Cells(i, 29).Value <> 0 Then
                .Cells(i, 31).Value = .Cells(i, 28).Value / .Cells(i, 29).Value - 1
            End If
         
            If .Range("AB74").Value <> 0 Then
                .Cells(i, 32).Value = .Cells(i, 28).Value / .Range("AB74").Value * 100
            End If
       
            If .Range("AC74").Value <> 0 Then
                .Cells(i, 33).Value = .Cells(i, 29).Value / .Range("AC74").Value * 100
            End If
       
            .Cells(i, 34).Value = .Cells(i, 32).Value - .Cells(i, 33).Value
       
        For x = 84 To 97
         
               .Cells(x, 30).Value = .Cells(x, 28).Value - .Cells(x, 29).Value

            If .Cells(x, 29).Value <> 0 Then
                .Cells(x, 31).Value = .Cells(x, 28).Value / .Cells(x, 29).Value - 1
            End If
         
            If .Range("AB84").Value <> 0 Then
                .Cells(x, 32).Value = .Cells(x, 28).Value / .Range("AB84").Value * 100
            End If
       
            If .Range("AC84").Value <> 0 Then
                .Cells(x, 33).Value = .Cells(x, 29).Value / .Range("AC84").Value * 100
            End If
       
            .Cells(x, 34).Value = .Cells(x, 32).Value - .Cells(x, 33).Value
           
        For z = 98 To 106
         
               .Cells(z, 30).Value = .Cells(z, 28).Value - .Cells(z, 29).Value

            If .Cells(z, 29).Value <> 0 Then
                .Cells(z, 31).Value = .Cells(z, 28).Value / .Cells(z, 29).Value - 1
            End If
         
            If .Range("AB98").Value <> 0 Then
                .Cells(z, 32).Value = .Cells(z, 28).Value / .Range("AB98").Value * 100
            End If
       
            If .Range("AC98").Value <> 0 Then
                .Cells(z, 33).Value = .Cells(z, 29).Value / .Range("AC98").Value * 100
            End If
       
            .Cells(z, 34).Value = .Cells(z, 32).Value - .Cells(z, 33).Value
           
        For h = 107 To 115
         
               .Cells(h, 30).Value = .Cells(h, 28).Value - .Cells(h, 29).Value

            If .Cells(h, 29).Value <> 0 Then
                .Cells(h, 31).Value = .Cells(h, 28).Value / .Cells(h, 29).Value - 1
            End If
         
            If .Range("AB107").Value <> 0 Then
                .Cells(h, 32).Value = .Cells(h, 28).Value / .Range("AB107").Value * 100
            End If
       
            If .Range("AC107").Value <> 0 Then
                .Cells(h, 33).Value = .Cells(h, 29).Value / .Range("AC107").Value * 100
            End If
       
            .Cells(h, 34).Value = .Cells(h, 32).Value - .Cells(h, 33).Value
           
           
        For f = 116 To 120
         
               .Cells(f, 30).Value = .Cells(f, 28).Value - .Cells(f, 29).Value

            If .Cells(f, 29).Value <> 0 Then
                .Cells(f, 31).Value = .Cells(f, 28).Value / .Cells(f, 29).Value - 1
            End If
         
            If .Range("AB116").Value <> 0 Then
                .Cells(f, 32).Value = .Cells(f, 28).Value / .Range("AB116").Value * 100
            End If
       
            If .Range("AC116").Value <> 0 Then
                .Cells(f, 33).Value = .Cells(f, 29).Value / .Range("AC116").Value * 100
            End If
       
            .Cells(f, 34).Value = .Cells(f, 32).Value - .Cells(f, 33).Value
           
        For t = 121 To 127
         
               .Cells(t, 30).Value = .Cells(t, 28).Value - .Cells(t, 29).Value

            If .Cells(t, 29).Value <> 0 Then
                .Cells(t, 31).Value = .Cells(t, 28).Value / .Cells(t, 29).Value - 1
            End If
         
            If .Range("AB121").Value <> 0 Then
                .Cells(t, 32).Value = .Cells(t, 28).Value / .Range("AB121").Value * 100
            End If
       
            If .Range("AC121").Value <> 0 Then
                .Cells(t, 33).Value = .Cells(t, 29).Value / .Range("AC121").Value * 100
            End If
       
            .Cells(t, 34).Value = .Cells(t, 32).Value - .Cells(t, 33).Value
           
                             Next t
                       Next f
                   Next h
                Next z
            Next x
        Next i
    End With
   
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
   
End Sub

 

[Kenneth Hobson]

Always test on backup copy.

For one thing, I see a purpose to the multiple level For loops.

This could probably be sped up by putting results into an array. I would have to think on that more. See if this will suffice.

Sub k1Math()
  Dim calc As Integer, ws As Worksheet
 
  On Error GoTo EndSub
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With
 
  Set ws = Worksheets("AC")
  k2Math 74, 83, ws
  k2Math 84, 97, ws
  k2Math 98, 106, ws
  k2Math 107, 115, ws
  k2Math 116, 120, ws
  k2Math 121, 127, ws
 
EndSub:
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = calc
    .CutCopyMode = False
  End With
End Sub

Sub k2Math(j As Long, k As Long, ws As Worksheet)
  Dim i As Long
  With ws
    For i = j To k
      .Cells(i, "AD").Value = .Cells(i, "AB").Value - .Cells(i, "AC").Value
     
      If .Cells(i, "AC").Value <> 0 Then _
        .Cells(i, "AE").Value = .Cells(i, "AB").Value / .Cells(i, "AC").Value - 1
     
      If .Cells(j, "AB").Value <> 0 Then _
        .Cells(i, "AF").Value = .Cells(i, "AB").Value / .Cells(j, "AB").Value * 100
     
      If .Cells(j, "AC").Value <> 0 Then _
        .Cells(i, "AG").Value = .Cells(i, "AC").Value / .Range(j, "AC").Value * 100
     
      .Cells(i, "AH").Value = .Cells(i, "AF").Value - .Cells(i, "AG").Value
    Next i
  End With
End Sub

 

[Marc L]

Hi !

i was wondering if there is a way speed up the run time.

Yes ! Often Excel inner features are faster than any VBA loop !
So here just use formulas within your code without any loop …

And as per forums rules without initial and result samples workbooks
it can be a mess to clearly help …
​

 

[Dokat]

Hi,

What do you mean by just use formula within your code without any loop. Not sure how i can do that since i need to specify each reference cell. Please attached sample file

 

[NARAYANK991]

Hi ,

In an earlier question of yours , we had raised the issue of why your For ... Next loops are all nested , one within the other.

There it was agreed that they need not be nested.

The problem with this procedure that you have posted is the same ; remove the nesting and the procedure completes almost instantaneously.

Sub MathYTDFORMBRANDAC()
    Dim i As Integer, x As Integer, z As Integer, h As Integer, f As Integer, t As Integer
    Dim condition As Range
  
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
  
    With Sheets("AC")
        For i = 74 To 83
            .Cells(i, 30).Value = .Cells(i, 28).Value - .Cells(i, 29).Value

            If .Cells(i, 29).Value <> 0 Then
              .Cells(i, 31).Value = .Cells(i, 28).Value / .Cells(i, 29).Value - 1
            End If
      
            If .Range("AB74").Value <> 0 Then
              .Cells(i, 32).Value = .Cells(i, 28).Value / .Range("AB74").Value * 100
            End If
    
            If .Range("AC74").Value <> 0 Then
              .Cells(i, 33).Value = .Cells(i, 29).Value / .Range("AC74").Value * 100
            End If
    
            .Cells(i, 34).Value = .Cells(i, 32).Value - .Cells(i, 33).Value
        Next
      
        For x = 84 To 97
            .Cells(x, 30).Value = .Cells(x, 28).Value - .Cells(x, 29).Value

            If .Cells(x, 29).Value <> 0 Then
              .Cells(x, 31).Value = .Cells(x, 28).Value / .Cells(x, 29).Value - 1
            End If
      
            If .Range("AB84").Value <> 0 Then
              .Cells(x, 32).Value = .Cells(x, 28).Value / .Range("AB84").Value * 100
            End If
    
            If .Range("AC84").Value <> 0 Then
              .Cells(x, 33).Value = .Cells(x, 29).Value / .Range("AC84").Value * 100
            End If
    
            .Cells(x, 34).Value = .Cells(x, 32).Value - .Cells(x, 33).Value
        Next
      
        For z = 98 To 106
            .Cells(z, 30).Value = .Cells(z, 28).Value - .Cells(z, 29).Value

            If .Cells(z, 29).Value <> 0 Then
              .Cells(z, 31).Value = .Cells(z, 28).Value / .Cells(z, 29).Value - 1
            End If
      
            If .Range("AB98").Value <> 0 Then
              .Cells(z, 32).Value = .Cells(z, 28).Value / .Range("AB98").Value * 100
            End If
    
            If .Range("AC98").Value <> 0 Then
              .Cells(z, 33).Value = .Cells(z, 29).Value / .Range("AC98").Value * 100
            End If
    
            .Cells(z, 34).Value = .Cells(z, 32).Value - .Cells(z, 33).Value
        Next
      
        For h = 107 To 115
            .Cells(h, 30).Value = .Cells(h, 28).Value - .Cells(h, 29).Value

            If .Cells(h, 29).Value <> 0 Then
              .Cells(h, 31).Value = .Cells(h, 28).Value / .Cells(h, 29).Value - 1
            End If
      
            If .Range("AB107").Value <> 0 Then
              .Cells(h, 32).Value = .Cells(h, 28).Value / .Range("AB107").Value * 100
            End If
    
            If .Range("AC107").Value <> 0 Then
              .Cells(h, 33).Value = .Cells(h, 29).Value / .Range("AC107").Value * 100
            End If
    
            .Cells(h, 34).Value = .Cells(h, 32).Value - .Cells(h, 33).Value
        Next
      
        For f = 116 To 120
            .Cells(f, 30).Value = .Cells(f, 28).Value - .Cells(f, 29).Value

            If .Cells(f, 29).Value <> 0 Then
              .Cells(f, 31).Value = .Cells(f, 28).Value / .Cells(f, 29).Value - 1
            End If
      
            If .Range("AB116").Value <> 0 Then
              .Cells(f, 32).Value = .Cells(f, 28).Value / .Range("AB116").Value * 100
            End If
    
            If .Range("AC116").Value <> 0 Then
              .Cells(f, 33).Value = .Cells(f, 29).Value / .Range("AC116").Value * 100
            End If
    
            .Cells(f, 34).Value = .Cells(f, 32).Value - .Cells(f, 33).Value
        Next
      
        For t = 121 To 127
            .Cells(t, 30).Value = .Cells(t, 28).Value - .Cells(t, 29).Value

            If .Cells(t, 29).Value <> 0 Then
              .Cells(t, 31).Value = .Cells(t, 28).Value / .Cells(t, 29).Value - 1
            End If
      
            If .Range("AB121").Value <> 0 Then
              .Cells(t, 32).Value = .Cells(t, 28).Value / .Range("AB121").Value * 100
            End If
    
            If .Range("AC121").Value <> 0 Then
              .Cells(t, 33).Value = .Cells(t, 29).Value / .Range("AC121").Value * 100
            End If
    
            .Cells(t, 34).Value = .Cells(t, 32).Value - .Cells(t, 33).Value
        Next t
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Narayan

 

[Dokat]

Thank you. That solved the problem.

 

[Marc L]

What do you mean by just use formula

TEBV rule : if you just know Excel formulas basics
every loop can be replaced by an easy formula on a range of cells …
Just applying directly formulas in cells, a VBA code becomes so easy !
See for example this thread : Alteration in Macro …

Think Excel Before VBA !
​