Excel Macro to add COUNTA to new top row

Question

I have an Excel 2013 worksheet where each column has a header row, and then the word "DIRECT" in some or all of the cells. No other data exists in the columns, just "DIRECT" or blanks. No columns are blank, they all have "DIRECT" at least once.

I'm looking for a macro that does the following:

Adds a new top row
Ignores the original header row, but gets a count of the cells with "DIRECT" in them
Puts that number in the corresponding new top cell for each column
Does the above actions for each column in the worksheet
Works regardless of the last column or row with data (I have to run this on several different-sized worksheets)

I recorded a macro that gets close, but it has two problems:

It adds the COUNTA data out to the last row of the workbook, which isn't needed (the populated columns will be a couple hundred, not thousands)
It references a specific cell range, so could cut off data for sheets with more rows

Sub AddColumnCountsRecorded()
'
' AddColumnCounts Macro
'

'
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(R[2]C:R[15]C)"
    Range("J1").Select
    Selection.Copy
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Paste
End Sub

If it helps:

Column "A" can determine the last row where data could be (that's the "username" column", so no blanks there) - although this last row will also change from sheet to sheet.
Row 2 (the header row) can determine the last column where data could be - it has no blank columns; in each column, at least one cell will have the word "DIRECT".

Any advice on editing the existing macro or concocting a new one from scratch would be greatly appreciated!

Thanks!

UPDATE:

Much thanks to Scott, here's what I ended up with - this adds the non-blank cell count to the active worksheet and stops at the last row with data in it. I just call it directly, without the 2nd section of code proposed below:

Sub AddColumnCountsRecorded()

    With ActiveSheet

        .Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        Dim lRow As Long, lCol As Long
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column

        .Range(.Cells(1, 2), .Cells(1, lCol)).FormulaR1C1 = "=COUNTA(R[2]C:R[" & lRow & "]C)"

    End With

End Sub

Read into how to avoid using .Select, it'll help tighten and speed up your macro. — BruceWayne

Scott Holtzman Scott Holtzman · Accepted Answer · 2016-07-11T19:22:31

Give this a shot. I made a separate sub that you can pass the worksheet reference too.

Sub AddColumnCountsRecorded(ws As Worksheet)

    With ws

        .Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

        Dim lRow As Long, lCol As Long
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
        lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column

        .Range(.Cells(1, 2), .Cells(1, lCol)).FormulaR1C1 = "=COUNTA(R[2]C:R[" & lRow & "]C)"

    End With

End Sub

Call it like this:

Sub ColumnCount()

    AddColumnCountsRecorded Worksheets("Sheet1")

End Sub

Excel Macro to add COUNTA to new top row

1 Answers