Reduce Runtime For This Code

**moo5003** · 08-19-2011, 03:16 PM

Hey Everyone,

I'm somewhat new to VBA (just learned how to use it a few months ago), so any assistance would be appreciated.

I've created some VBA to cycle through risk numbers and copy paste the output for each on a seperate tab. I was hoping you guys could take a look at my code and let me know if there is anything I can do that would reduce run time. My workbook is rating insurance policies, sometimes up to 100,000 risks. Anything that would reduce runtime would be appreciated. Below is the main code, the most time consuming part would be the one For loop.

Sub Main()

Dim W As Integer
Dim Lbl As Single

Sheets("SC UNA").Select
W = Range("V7").Value
Lbl = 0
Application.ScreenUpdating = False
   
For i = 1 To W
    
    Sheets("SC UNA").Cells(2, 1).Value = i - 1
    Sheets("SC UNA").Range("Q39").Copy
    Sheets("Rating Examples").Cells(i + 1, 129).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
           
    With Progress
        Lbl = i / W
        .Frame1.Caption = Format(Lbl, "0%")
        .Label2.Width = Lbl * (.Frame1.Width - 7)
        .Label4.Caption = i
    End With
    
    DoEvents

Next i

Sheets("Summary").Select
Range("G2").Formula = "=IF(COUNTIF($L$3:$L$" & W + 2 & ",A2)>=1,1,0)"
Range("A2:H2").Copy
Range(Cells(2, 1), Cells(W + 1, 8)).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("I4").Formula = "=Max(F2:F" & W + 1 & ")"
Range("I5").Formula = "=Min(F2:F" & W + 1 & ")"
Range("J4").Formula = "=VLOOKUP($I$4,$F$2:$H$" & W + 1 & ",3,False)"
Range("J5").Formula = "=VLOOKUP($I$5,$F$2:$H$" & W + 1 & ",3,False)"
Range("J9").Formula = "=VLOOKUP($J$8,$A$2:$H$" & W + 1 & ",2,False)"
Range("J10").Formula = "=VLOOKUP($J$8,$A$2:$H$" & W + 1 & ",3,False)"
Range("J11").Formula = "=VLOOKUP($J$8,$A$2:$H$" & W + 1 & ",5,False)"

Unload Progress
ActiveWorkbook.RefreshAll
Sheets("Summary").Select
Cells(3, 1).Select

End Sub

**snb** · 08-19-2011, 03:34 PM

 
Sub Main()
  with Application
    .ScreenUpdating = False
    .enableevents=false
    .calculation=xlcalculationmanual
    .DisplayStatusBar = True
  end with
 
  With Sheets("SC UNA")
    For j = 1 To .Range("V7").Value
      .Cells(2, 1).Value = j - 1
      Sheets("Rating Examples").Cells(j + 1, 129)=.Range("Q39").value
      application.statusbar formatpercent( j/.range("V7").value,1)
    Next 
  end with

  With Sheets("Summary")
    .Range("G2") = "=IF(COUNTIF($L$3:$L$" & j + 1 & ",A2)>=1,1,0)"
    .Range("A2:H2").Copy .Range(Cells(2, 1), Cells(j, 8))   
    .Range("I4") = "=Max(F2:F" & j & ")"
    .Range("I5") = "=Min(F2:F" & j & ")"
    .Range("J4") = "=VLOOKUP($I$4,$F$2:$H$" & j & ",3,False)"
    .Range("J5") = "=VLOOKUP($I$5,$F$2:$H$" & j & ",3,False)"
    .Range("J9") = "=VLOOKUP($J$8,$A$2:$H$" & j & ",2,False)"
    .Range("J10") = "=VLOOKUP($J$8,$A$2:$H$" & j & ",3,False)"
    .Range("J11") = "=VLOOKUP($J$8,$A$2:$H$" & j & ",5,False)"
  End With

  with Application
    .enableevents=trie
    .calculation=xlcalculationautomatic
  end with
End Sub

**moo5003** · 08-19-2011, 03:57 PM

Just tried your revisions SNB. While there was an incredible difference in run time, with application.calculation=xlcalculationmanual

The rates did not change when changing risk #. It seems I'm unable to implement that portion. When I remove that piece the run time goes back to being a little sluggish.

**snb** · 08-19-2011, 04:56 PM

The rates did not change when changing risk #.

doesn't make sense to me.
If you want effective help please post a sample workbook.
I think you won't need any formulas, but can do the calulations in memory.