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