Have Excel Auto Populate Column Headings in Blank Rows (VBA?)

Question

I have a spreadsheet that looks something like this:

             A       B       C       D       E       F       
    1     Program  Year    Cycle   Date    Panel  Mtg Rep
    2       AAA    2019      1     5/21     ABA     Tom
    3       AAA    2019      1     5/23     ABB     Erin
    4
    5       BBB    2019      2     6/4      BAB     Jim
    6
    7       CCC    2019      3     7/16     CAB     Tom
    8       CCC    2019      4     8/27     CBB     Kate
    9
    10

What I'm trying to have it do is, every time a row is skipped, that blank row will automatically be populated with the column headings. So in the example table above, rows 4 and 6 would contain the column headings, while row 9 would remain blank until information was entered on row 10. I've done every possible search I can think of, and haven't found anything that seems applicable. I'm not very familiar with VBA, so I came up with the following series of formulas:

A3) =IF(AND($A2<>"",$A4<>"",$A2<>$A$1),$A$1,"")
B3) =IF(A3=A$1,B$1,"")
C3) =IF(B3=B$1,C$1,"")
D3) =IF(C3=C$1,D$1,"")
E3) =IF(D3=D$1,E$1,"")
F3) =IF(E3=E$1,F$1,"")

These formulas are then extended to the rest of the sheet. This does what I want it to do, but it also fills 8,000+ cells with formulas, including circular references. Which, aside from having to deal with being alerted to the circular references, they also affect other aspects of my sheet, such as conditional formatting, identifying duplicate entries, etc.

As I stated, I'm not really very familiar with VBA, so I don't even know if this is doable using VBA. But if there is some way to achieve the same result without formulas, or at least without circular references, that is what I'm looking for. Thanks so much for any assistance.

Answer 1

This code should work:

see before:

and after:

Sub addHeaders()

Dim ws As Worksheet
    Set ws = Sheets("Sheet3")

Dim lastRow As Integer
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

Dim header As Range
    Set header = ws.Range("A1:F1")

For rowNum = 2 To lastRow
    If ws.Cells(rowNum, 1) = "" Then
        If ws.Cells(rowNum + 1, 1) <> "" Then
             ws.Range("A" & rowNum & ":F" & rowNum) = header.Value
         End If
     End If
Next rowNum
End Sub

Since you said you are new to vba here is quick quick intro to how to run a program:

1. 

2. 

3. 

Answer 2

Something like this is what you're looking for:

Sub tgr()

    Dim ws As Worksheet
    Dim rHeaders As Range
    Dim rDest As Range
    Dim ACell As Range

    Set ws = ActiveWorkbook.ActiveSheet
    Set rHeaders = ws.Range("A1:F1")

    For Each ACell In ws.Range("A1", ws.Cells(ws.Rows.Count, "A").End(xlUp)).Cells
        If Len(Trim(ACell.Value)) = 0 Then
            If Not rDest Is Nothing Then
                Set rDest = Union(rDest, ACell)
            Else
                Set rDest = ACell
            End If
        End If
    Next ACell

    If Not rDest Is Nothing Then rHeaders.Copy rDest

End Sub