Forum Discussion

KristelNulens's avatar
KristelNulens
Copper Contributor
Jan 19, 2023

Adding rows with counts to spreadsheet using VBA

I would like to change this spreadsheet, to look like the spreadsheet underneath, using VBA.   In other words, blank records need to be added underneath each unique value in column D. T...
Macros and VBA
HansVogelaar's avatar
HansVogelaar
MVP
Jan 19, 2023

KristelNulens 

You had dynamic array formulas in columns B and D. These prevent rows from being inserted, so I replaced them with single-cell formulas.

Then this macro works:

Sub Macro3()
    Dim rng As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Range("A1").Subtotal _
        GroupBy:=4, _
        Function:=xlSum, _
        TotalList:=Array(12, 13, 14, 15, 16, 17, 18, 19, 20), _
        Replace:=True, _
        PageBreaks:=False, _
        SummaryBelowData:=True
    Set rng = Range("D:D").Find(What:="Total", LookAt:=xlPart)
    Do
        rng.ClearContents
        rng.Offset(0, -3).Value = rng.Offset(-1, -1).Value
        rng.Offset(0, -1).Value = "Patient"
        rng.Offset(0, 7).Value = "Count"
        rng.EntireRow.Interior.Color = vbYellow
        Set rng = Range("D:D").Find(What:="Total", After:=rng, LookAt:=xlPart)
    Loop Until rng.Value = "Grand Total"
    rng.Offset(0, 7).Value = "Count"
    rng.EntireRow.Interior.Color = vbRed
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Resources