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