One for the coding experts - Locate the error in my subtotal macro?

[MarathonZephead]

Hello

I was kindly given the code below 11 years ago by a very kind member of the board whom I've lost contact with, and it's stopped producing the right result and I can't figure out why.

The code runs when I click a custom button and inserts 3 rows where the selected cell is. The first row is subtotals, the second row ranks the subtotals and the third row is data copied from row 369. When I click the button again, the 3 rows are deleted.

I can't figure out why the subtotals always show zero, even though the formula shown in each of the subtotal cells shows the correct function and range.

Here's the code:

'Main macro courtesy of Florante Kho 2003
'Progress Timer courtesy of Justin Labenne 10.2005
Sub YTDSubtotals()
Dim PB As clsDailyTrackingProgressBar
Dim nCounter As Integer
Dim lWaitCount As Long

Set PB = New clsDailyTrackingProgressBar

With PB
    .Title = "Daily Tracking YTD Mileage Subtotals"
    .Caption1 = "Working..."
    .Caption2 = "Please wait..."
    .Show
        '-----------------------
        .Progress = 5
        .Caption3 = "Completed " & (CStr(5) & "%")
        '-----------------------
Dim AddRange, Add1stCell As String
Dim Maxcol As Integer
Dim Currcell As Range
On Error Resume Next
Set Currcell = ActiveCell
Worksheets("Daily Tracking").Activate
Application.ScreenUpdating = False
Application.EnableEvents = False
    Dim Restoring As Boolean
        
        Maxcol = Range("A1:CF1").Find(Year(Now())).Column
        Range("A2:A368").Find("Subtot").EntireRow.Delete
        Range("A2:A368").Find("Rank").EntireRow.Delete
        Range("A2:A368").Find("Year").EntireRow.Delete
        If Err = 0 Then
            Restoring = True
        Else
            Restoring = False
        End If
        
        If Not (Restoring) And ActiveCell.Row < 370 Then 'to prevent from adding extra row when there is no date in the column A
            Rows(ActiveCell.Row).Insert Shift:=xlDown
            Range("A" & ActiveCell.Row).Value = "SUBTOT"
            AddRange = Replace(Range("B2:B" & ActiveCell.Row - 1).Address, "$", "")
            Range("B" & ActiveCell.Row) = "=SUM(" & AddRange & ")"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FillRight
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).Font.Bold = True
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).NumberFormat = "0"
            Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, Maxcol)).Interior.ColorIndex = 35
        
'Address for the cell to have conditional formating
            add1 = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).Address
'Remove any prior formating
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Delete
'Condition 1
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                Formula1:="=LARGE(" & add1 & ",1)"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(1).Font.ColorIndex = 44
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(1).Interior.ColorIndex = 1
'Condition 2
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                Formula1:="=LARGE(" & add1 & ",2)"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(2).Font.ColorIndex = xlAutomatic
   
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(2).Interior.ColorIndex = 15
'Condition 3
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                Formula1:="=LARGE(" & add1 & ",3)"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(3).Font.ColorIndex = xlAutomatic
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(3).Interior.ColorIndex = 40

        '-----------------------
        .Progress = 25
        .Caption3 = "Completed " & (CStr(25) & "%")
        '-----------------------
        
'Move one row down
            ActiveCell.Offset(1, 0).Select
            Rows(ActiveCell.Row).Insert Shift:=xlDown
            Range("A" & ActiveCell.Row) = "RANK"

'Address of the cell to have conditional formating
            AddRange = Range(Cells(ActiveCell.Row - 1, 2), Cells(ActiveCell.Row - 1, Maxcol)).Address

        '-----------------------
        .Progress = 50
        .Caption3 = "Completed " & (CStr(50) & "%")
        '-----------------------

'Address of the 1st cell to have conditional formating
            Add1stCell = Replace(Range(Cells(ActiveCell.Row - 1, 2), Cells(ActiveCell.Row - 1, 2)).Address, "$", "")
            Range("B" & ActiveCell.Row) = "=RANK(" & Add1stCell & "," & AddRange & ",0)"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FillRight

'Remove prior format conditioning
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Delete
        
        '-----------------------
        .Progress = 75
        .Caption3 = "Completed " & (CStr(75) & "%")
        '-----------------------

'1st condition
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:="1"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(1).Interior.ColorIndex = 1
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(1).Font.ColorIndex = 44

'2nd condition
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:="2"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(2).Interior.ColorIndex = 15
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(2).Font.ColorIndex = xlAutomatic

'3rd condition
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
            Formula1:="3"
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(3).Interior.ColorIndex = 40
            Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, Maxcol)).FormatConditions(3).Font.ColorIndex = xlAutomatic
            ActiveCell.Offset(-1, 0).Activate
'Moves the cursor up 1 row - the '0' instructs the cursor to remain within the same column

'==========End new row =============
            ActiveCell.Offset(2, 0).Activate
            Rows(ActiveCell.Row).Insert Shift:=xlDown
            Range(Cells(1, 1), Cells(1, Maxcol)).Copy
            Range("A" & ActiveCell.Row).PasteSpecial xlPasteValues
            Range("A" & ActiveCell.Row).PasteSpecial xlPasteFormats
            Range("A" & ActiveCell.Row) = "YEAR"
            
'==========Start new row =============
            Application.CutCopyMode = False
            Currcell.Activate
            ActiveCell.Offset(-3, 0).Activate
            
        '-----------------------
            .Progress = 100
            .Caption3 = "Completed " & (CStr(100) & "%")
        '-----------------------

        End If
Application.ScreenUpdating = True
Application.EnableEvents = True
            If UserCancelled = True Then GoTo EndRoutine
               
EndRoutine:
    .Finish
   
End With
Set PB = Nothing

End Sub

Many thanks!