AR Aging Cleanup via VBA

I am working to 'clean up' an AR aging that is being Exported from Microsoft Dynamics (formerly Great Plains) and can't seem to get this to work correctly.

The VBA is looking through the file to strip it down to a raw detail for easier summarization and pivot table use. And this will be done frequently on daily or monthly basis as needed.

I've attached a sample and the below code as well. If you run the macro, you'll see what I'm getting at. And this appears close I think, yet always gives the wrong totals. I think part of that is the document exporting the payment info into Column D but not all the time.

I just can't figure If I'm missing something in the macro, maybe a bad file?

Sub Testing()
    Dim LastRow, LastCol, HeaderRow As Long
    Dim rng, rCell As Range
    Dim ColNum As String
    
    Sheets("Original").Copy After:=Sheets(Sheets.Count)
    
    'ActiveSheet.Name = "NewWS"
    
    LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    
    'Copy the Customer Number and Name Down for blank values
    Set rng = Range("A2:A" & LastRow).SpecialCells(4)
    For Each rCell In rng
        rCell.Value = rCell.Offset(-1).Value
    Next rCell
    
    'Start Clean Up. Work off of the 'Amount' Column
    Cells.Find(What:="Amount", LookIn:=xlFormulas, LookAt:=xlWhole).Activate
    ColNum = ColumnLetter(ActiveCell.Column)
    
    'Remove Stuff Above Header
    HeaderRow = ActiveCell.Row - 1
    Rows("1:" & HeaderRow).EntireRow.Delete
    
    Set rng = Range(ColNum & "2:" & ColNum & LastRow)
    'Shift Payment Date and Info Over if necessary
    For Each rCell In rng
        If IsDate(rCell.Offset(0, -2)) Then
            rCell.Value = rCell.Offset(0, -1).Value
            rCell.Offset(0, 1).Value = rCell.Offset(0, -1).Value
            rCell.Offset(0, -1) = Format(rCell.Offset(0, -2), "Short Date")
            rCell.Offset(0, -2) = JUSTLETTERS(rCell.Offset(0, -3))
        End If
    Next rCell

    'Next Remove all Customer Totals
    For Each rCell In rng
        If Not IsDate(rCell.Offset(0, -1)) Then
            rCell.EntireRow.Delete
        End If
    Next rCell
    
    Set rng = Range("A2:" & ColNum & LastRow)
    For Each rCell In rng
        If rCell = "." Or rCell = "Balance" Then
            rCell.EntireRow.Delete
        End If
    Next rCell
      
    'Recompute Last Row and Column
    LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
    
    'Format Numbers
    Cells.Find(What:="Amount", LookIn:=xlFormulas, LookAt:=xlWhole).Activate
    Set rng = Range(ActiveCell.Offset(1, 0).Address & ":" & ColumnLetter(ActiveCell.End(xlToRight).Column) & LastRow)
    For Each rCell In rng
        rCell.Value = rCell.Value / 1000
        rCell.Value = rCell.Value * 1000
        rCell.Value = Format(rCell.Value, "Currency")
    Next rCell

    
End Sub



Function JUSTLETTERS(pWorkRng As Range) As String
    Dim xValue As String
    Dim OutValue As String
    Dim XIndex As Long

    xValue = pWorkRng.Value
    For XIndex = 1 To VBA.Len(xValue)
        If Not VBA.IsNumeric(VBA.Mid(xValue, XIndex, 1)) Then
            OutValue = OutValue & VBA.Mid(xValue, XIndex, 1)
        End If
    Next
    JUSTLETTERS = OutValue
End Function

Function ColumnLetter(ColumnNumber As Long) As String
    Dim n As Long
    Dim c As Byte
    Dim S As String

    n = ColumnNumber
    Do
        c = ((n - 1) Mod 26)
        S = Chr(c + 65) & S
        n = (n - c) \ 26
    Loop While n > 0
    ColumnLetter = S
End Function

Edit.
Forgot to mention, for some strange reason, you also get prompted about existing names existing, but there are no named ranges in the file?

It's not obvious to me what's wrong with the result from the example data provided.

I do see a potential problem with these two For-Next code blocks. If there are two adjacent rows that need to be deleted, the 2nd one will be jumped over and not deleted. Say rows 4 and 5 should be deleted. When the code deletes row 4, then row 5 shifts up to replace it. Then the code doesn't check row 4 again. It moves on and checks row 5 which is now the old row 6.

    Set rng = Range(ColNum & "2:" & ColNum & LastRow)
    'Shift Payment Date and Info Over if necessary
    For Each rCell In rng
        If IsDate(rCell.Offset(0, -2)) Then
            rCell.Value = rCell.Offset(0, -1).Value
            rCell.Offset(0, 1).Value = rCell.Offset(0, -1).Value
            rCell.Offset(0, -1) = Format(rCell.Offset(0, -2), "Short Date")
            rCell.Offset(0, -2) = JUSTLETTERS(rCell.Offset(0, -3))
        End If
    Next rCell

    'Next Remove all Customer Totals
    For Each rCell In rng
        If Not IsDate(rCell.Offset(0, -1)) Then
            rCell.EntireRow.Delete
        End If
    Next rCell

The solution is to loop through the rows from the bottom up to avoid missing a possible row.

    Application.ScreenUpdating = False
    Dim i As Long
    For i = LastRow To 2 Step -1
        If IsDate(Cells(i, ColNum).Offset(0, -2)) Then
            Cells(i, ColNum).Value = Cells(i, ColNum).Offset(0, -1).Value
            Cells(i, ColNum).Offset(0, 1).Value = Cells(i, ColNum).Offset(0, -1).Value
            Cells(i, ColNum).Offset(0, -1) = Format(Cells(i, ColNum).Offset(0, -2), "Short Date")
            Cells(i, ColNum).Offset(0, -2) = JUSTLETTERS(Cells(i, ColNum).Offset(0, -3))
        ElseIf Cells(i, "A") = "." Or Cells(i, "A") = "Balance" Or Cells(i, "B") = "" Then
            Rows(i).Delete
        End If
    Next i
    Application.ScreenUpdating = True

I don't know what to tell you. I couldn't even get the grand total $4,244,319 to equal the column sums on the original data. I used a SUMIF formula to sum each column excluding the "Totals:" rows e.g.;
=SUMIF($E$2:$E$3657,"<>Totals:",F2:F3657)
Then summed all those totals for F:J = $4,313,937.17

On the result data (Original 2), why do some PMT lines have the same values in E and F and others do not?