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. Those blank records should display the word 'Patient' in column C and the unique value of column C in column A. The counts I can probably add myself after somebody has helped me adding the rows.

1 Reply

  • 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