VBA - Use PivotTable and SpecialCells(xlCellTypeBlanks) to get totals rows

Twenty or so years ago when I learnt Excel VBA I read a book called Excel VBA Step-by-step, it was full of instructive examples as you can imagine. One example stuck with me, it used a pivottable to take some rows, do the totalling and finally format the totals back into normalised rows by pulling a trick using Excel.Range's method SpecialCells(xlCellTypeBlanks)

It remains the only use case for SpecialCells(xlCellTypeBlanks) I have encountered.

Option Explicit

Sub Test()
    Test_FillInPivotBlanks_InitialiseSheet_RunOnce
    Test_FillInPivotBlanks_CreatePivot_RunOnce
    Test_FillInPivotBlanks
End Sub

Private Function WorkingSheet() As Excel.Worksheet
    Set WorkingSheet = Sheet1 '* add as required
End Function

Sub Test_FillInPivotBlanks_InitialiseSheet_RunOnce()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet
    sh.Cells.Clear
    
    Dim vSeed As Variant
    vSeed = [{"Colour","Shape","Number";"Red","Triangle",2;"Red","Triangle",22;"Red","Square",3;"Red","Circle",8;"Green","Square",13;"Blue","Circle",21}]
    
    sh.Range("a1:c7").Value2 = vSeed
End Sub

Sub Test_FillInPivotBlanks_CreatePivot_RunOnce()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet

    Dim rng As Excel.Range
    Set rng = sh.Range("a1").CurrentRegion
    rng.Select
    
    Dim rngDest As Excel.Range
    Set rngDest = sh.Range("f1")
    rngDest.CurrentRegion.Delete
    
    Dim pvtCache As Excel.PivotCache
    Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rng.Address, Version:=xlPivotTableVersion10)
        
    Dim pvtTable As Excel.PivotTable
    Set pvtTable = pvtCache.CreatePivotTable( _
        TableDestination:=sh.Name & "!R1C6", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion10)
    
    pvtTable.ColumnGrand = False
    pvtTable.RowGrand = False
    
    Dim pvtfldCol As Excel.PivotField
    Set pvtfldCol = pvtTable.PivotFields("Colour")
    pvtfldCol.Orientation = xlRowField
    pvtfldCol.Position = 1

    With pvtTable.PivotFields("Shape")
        .Orientation = xlRowField
        .Position = 2
        
    End With
    pvtTable.AddDataField pvtTable.PivotFields("Number"), "Sum of Number", xlSum
    
    pvtTable.PivotFields("Colour").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    

End Sub

Sub Test_FillInPivotBlanks()

    Dim sh As Excel.Worksheet
    Set sh = WorkingSheet

    Dim rngDest As Excel.Range
    Set rngDest = sh.Range("f1").CurrentRegion
    
    rngDest.Copy
    sh.Range("J1").PasteSpecial xlPasteValues

    Application.CutCopyMode = False

    Dim rngCopied As Excel.Range
    Set rngCopied = sh.Range("J1").CurrentRegion

    Dim rngBlanks As Excel.Range
    Set rngBlanks = rngCopied.SpecialCells(xlCellTypeBlanks)
    
    Dim rngBlankLoop As Excel.Range
    For Each rngBlankLoop In rngBlanks
        Debug.Assert IsEmpty(rngBlankLoop)
        rngBlankLoop.FormulaR1C1 = "=R[-1]C"
    Next rngBlankLoop

End Sub