• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro Speed Optimization

D

Dokat

Member
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

Code: 
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
 
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.
Code: 
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
 
Hi !
Dokat said:
i was wondering if there is a way speed up the run time.
Click to expand...
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 …
​
 
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
 

Attachments

  • Test.xlsb
    694.4 KB · Views: 1
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.
Code: 
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
 
You must log in or register to reply here.
Back
Top