program running extremely slow

**Toidz77** · 08-22-2009, 09:45 AM

Hello all.

I wrote what I thought was a pretty simple procedure to pull out selected info. from a colleague's report. I'm not finished yet, but the rest of the program would be much of the same from the first part. However, it runs very slow so before I continue I wanted some assistance with finding out what's causing the slow-down. I would greatly appreciate any guidance you can provide. Thanks!

Sub PDTrendingCalculate()
Range("Q2") = "#"
Range("R2") = "Week"
Range("S2") = "Pre-Procedure PDs"
Range("T2") = "Index Procedure PDs"
Range("U2") = "Discharge PDs"
Range("V2") = "30D PDs"
Range("W2") = "6M PDs"
Range("X2") = "Revascularization PDs"
Range("Y2") = "#Pts"
Range("Z2") = "Pre-Procedure Value"
Range("AA2") = "Index Procedure Value"
Range("AB2") = "Discharge Value"
Range("AC2") = "30D Value"
Range("AD2") = "6M Value"
Range("AE2") = "Revascularization Value"
Range("Q2:AE2").Select
With Selection
.Font.Bold = True
End With
Columns("S:AE").EntireColumn.AutoFit
Range("Q3").Select
ActiveCell = 1
Do
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
Loop Until IsEmpty(ActiveCell.Offset(1, 8))
Range("R3").Select
ActiveCell = "4/6/2009"
Do
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 7
Loop Until IsEmpty(ActiveCell.Offset(1, 7))
Range("S3").Select
Do
ActiveCell.FormulaR1C1 = _
"=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-1)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-1)+6)),--(R3C10:R3000C10=""Pre-procedure""))"
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(1, 6))
Range("Z3").Select
Do
ActiveCell.FormulaR1C1 = "=RC[-7]/RC[-1]"
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
Range("AA3").Select
Do
ActiveCell.FormulaR1C1 = "=RC[-7]/RC[-2]"
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
Range("AB3").Select
Do
ActiveCell.FormulaR1C1 = "=RC[-7]/RC[-3]"
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
Range("AC3").Select
Do
ActiveCell.FormulaR1C1 = "=RC[-7]/RC[-4]"
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
Range("AD3").Select
Do
ActiveCell.FormulaR1C1 = "=RC[-7]/RC[-5]"
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
Range("AE3").Select
Do
ActiveCell.FormulaR1C1 = "=RC[-7]/RC[-6]"
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
End Sub

**JBeaucaire** · 08-22-2009, 10:07 AM

Hi Toidz77. Welcome. Be sure to read through the Forum Rules so you can use and follow them effectively. For instance, you'll need to edit that post above and put code tags around that code you used. (like this...)

Sub PDTrendingCalculate()
Range("Q2") = "#"
Range("R2") = "Week"
Range("S2") = "Pre-Procedure PDs"

Also, that code will be far more meaningful if we could see it in action. Click GO ADVANCED and use the paperclip icon to post up your workbook.

**royUK** · 08-22-2009, 10:44 AM

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here

**Toidz77** · 08-24-2009, 01:03 PM

My apologies. The code I previously listed was changed to ehance the speed a bit and I'm happy with the performance ("PDTrendingCalculate") . The other code ("MakePivotTable"), however, runs even slower. I'm new to all of this so I would appreciate your expert guidance. For some background, the first code calculate's data from a colleague's report and the second uses that as source for a pivot table. The pivot table takes quite a while to complete.

Thanks in advance for your time and guidance.

Sub PDTrendingCalculate()
With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
End With
Dim sq As Variant
sq = Split("#|Week|Pre-Procedure PDs|Index Procedure PDs|Discharge PDs|30D PDs|6M PDs|Revascularization PDs|#Pts|Pre-Procedure Value|Index Procedure Value|Discharge Value|30D Value|6M Value|Revascularization Value", "|")
Range("Q2").Resize(, UBound(sq) + 1) = sq
Dim Rng1, Rng2, Rng3, Rng4, Rng5, Rng6, Rng7, Rng8, Rng9, Rng10, Rng11, Rng12, Rng13, Rng14 As Range
Set Rng1 = Range("Q3")
Rng1.Value = 1
Do
    Set Rng1 = Rng1.Offset(1)
    Rng1.Value = Rng1.Offset(-1).Value + 1
Loop Until IsEmpty(Rng1.Offset(1, 8))
Set Rng2 = Range("R3")
Rng2.Value = "4/6/2009"
Do
    Set Rng2 = Rng2.Offset(1)
    Rng2.Value = Rng2.Offset(-1).Value + 7
Loop Until IsEmpty(Rng2.Offset(1, 7))
Set Rng3 = Range("S3")
Rng3.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-1)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-1)+6)),--(R3C10:R3000C10=""Pre-Procedure""))"
Do
Set Rng3 = Rng3.Offset(1)
Rng3.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-1)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-1)+6)),--(R3C10:R3000C10=""Pre-Procedure""))"
Loop Until IsEmpty(Rng3.Offset(1, 6))
Set Rng10 = Range("T3")
Rng10.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-2)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-2)+6)),--(R3C10:R3000C10=""Index Procedure""))"
Do
Set Rng10 = Rng10.Offset(1)
Rng10.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-2)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-2)+6)),--(R3C10:R3000C10=""Index Procedure""))"
Loop Until IsEmpty(Rng10.Offset(1, 5))
Set Rng11 = Range("U3")
Rng11.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-3)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-3)+6)),--(R3C10:R3000C10=""Discharge""))"
Do
Set Rng11 = Rng11.Offset(1)
Rng11.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-3)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-3)+6)),--(R3C10:R3000C10=""Discharge""))"
Loop Until IsEmpty(Rng11.Offset(1, 4))
Set Rng12 = Range("V3")
Rng12.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-4)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-4)+6)),--(R3C10:R3000C10=""30 Days Follow-up""))"
Do
Set Rng12 = Rng12.Offset(1)
Rng12.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-4)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-4)+6)),--(R3C10:R3000C10=""30 Days Follow-up""))"
Loop Until IsEmpty(Rng12.Offset(1, 3))
Set Rng13 = Range("W3")
Rng13.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-5)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-5)+6)),--(R3C10:R3000C10=""6 Month Follow-up""))"
Do
Set Rng13 = Rng13.Offset(1)
Rng13.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-5)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-5)+6)),--(R3C10:R3000C10=""6 Month Follow-up""))"
Loop Until IsEmpty(Rng13.Offset(1, 2))
Set Rng14 = Range("X3")
Rng14.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-6)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-6)+6)),--(R3C10:R3000C10=""Revascularization""))"
Do
Set Rng14 = Rng14.Offset(1)
Rng14.Formula = "=SUMPRODUCT(--(R3C7:R3000C7+0>=OFFSET(RC,0,-6)),--(R3C7:R3000C7+0<=(OFFSET(RC,0,-6)+6)),--(R3C10:R3000C10=""Revascularization""))"
Loop Until IsEmpty(Rng14.Offset(1, 1))
Set Rng4 = Range("Z3")
Rng4.Formula = "=RC[-7]/RC[-1]"
Do
    Set Rng4 = Rng4.Offset(1)
    Rng4.Formula = "=RC[-7]/RC[-1]"
Loop Until IsEmpty(Rng4.Offset(1, -1))
Set Rng5 = Range("AA3")
Rng5.Formula = "=RC[-7]/RC[-2]"
Do
    Set Rng5 = Rng5.Offset(1)
    Rng5.Formula = "=RC[-7]/RC[-2]"
Loop Until IsEmpty(Rng5.Offset(1, -2))
Set Rng6 = Range("AB3")
Rng6.Formula = "=RC[-7]/RC[-3]"
Do
    Set Rng6 = Rng6.Offset(1)
    Rng6.Formula = "=RC[-7]/RC[-3]"
Loop Until IsEmpty(Rng6.Offset(1, -3))
Set Rng7 = Range("AC3")
Rng7.Formula = "=RC[-7]/RC[-4]"
Do
    Set Rng7 = Rng7.Offset(1)
    Rng7.Formula = "=RC[-7]/RC[-4]"
Loop Until IsEmpty(Rng7.Offset(1, -4))
Set Rng8 = Range("AD3")
Rng8.Formula = "=RC[-7]/RC[-5]"
Do
    Set Rng8 = Rng8.Offset(1)
    Rng8.Formula = "=RC[-7]/RC[-5]"
Loop Until IsEmpty(Rng8.Offset(1, -5))
Set Rng9 = Range("AE3")
Rng9.Formula = "=RC[-7]/RC[-6]"
Do
    Set Rng9 = Rng9.Offset(1)
    Rng9.Formula = "=RC[-7]/RC[-6]"
Loop Until IsEmpty(Rng9.Offset(1, -6))
With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
End With
End Sub

Sub MakePivotTable()
 Sheets.Add
 ActiveSheet.Name = "Pivot Table"
 Dim DataRange As Range
 Dim Destination As Range
 Set Destination = Worksheets("Pivot Table").Range("A1")
 Set DataRange = Worksheets("PD List").Range("Q2").CurrentRegion
 ActiveSheet.PivotTableWizard _
 SourceType:=xlDatabase, SourceData:=DataRange, _
 TableDestination:=Destination, TableName:="PDTrending"
 With ActiveSheet.PivotTables("PDTrending").PivotFields("Week")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PDTrending").AddDataField ActiveSheet.PivotTables( _
        "PDTrending").PivotFields("Pre-Procedure Value"), "Pre-Procedure  Value" _
        , xlSum
    ActiveSheet.PivotTables("PDTrending").AddDataField ActiveSheet.PivotTables( _
        "PDTrending").PivotFields("Index Procedure Value"), _
        "Index Procedure  Value", xlSum
    ActiveSheet.PivotTables("PDTrending").AddDataField ActiveSheet.PivotTables( _
        "PDTrending").PivotFields("Discharge Value"), "Discharge  Value", xlSum
    ActiveSheet.PivotTables("PDTrending").AddDataField ActiveSheet.PivotTables( _
        "PDTrending").PivotFields("30D Value"), "30D  Value", xlSum
    ActiveSheet.PivotTables("PDTrending").AddDataField ActiveSheet.PivotTables( _
        "PDTrending").PivotFields("6M Value"), "6M  Value", xlSum
    ActiveSheet.PivotTables("PDTrending").AddDataField ActiveSheet.PivotTables( _
        "PDTrending").PivotFields("Revascularization Value"), _
        "Revascularization  Value", xlSum
    With ActiveSheet.PivotTables("PDTrending")
        .ColumnGrand = False
        .RowGrand = False
    End With
    Columns("A:A").EntireColumn.AutoFit
    ActiveWorkbook.ShowPivotTableFieldList = False
    End Sub