Excel VBA - Run through multiple row, if a row is blank, enter a section of headers

Question

I'm writing a macro to sort through a large file of data at work. I've inserted a blank row at the top of different section of data. I want my code to realize when a row is blank in column C, then fill in a set of headers in that row. It should then continue to find the next blank in column C. This should continue until my code finds 2 consecutive blanks, which signals the end of my data.

Currently, my code inserts the desired headers, but only in the first row of my worksheet. I believe that I need to change the loop contained inside my "Do... Loop Until" function. I just can't seem to get the correct code to achieve my desired results.

I've included a screencapture of roughly what my spreadsheet will look like.

Any help or advice is greatly appreciated.

This is the code I have so far:

Sub AddHeaders()

'Add headers below each section title
Dim Headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim LastRow As Long, Row As Long

Application.ScreenUpdating = False 'turn this off for the macro to run a 
little faster

Set wb = ActiveWorkbook

LastRow = Cells(Rows.Count, 1).End(xlUp).Row
ActiveCell = Cells(1, 3)

Headers() = Array("Item", "Configuration", "Drawing/Document Number", 
"Title", "ECN", "Date", "Revisions")
' Set Do loop to stop when two consecutive empty cells are reached.
Do
For Row = 1 To LastRow 'Add a loop to go through the cells in each row?
    If IsEmpty(ActiveCell) = True Then 'If row is empty, then go in and add headers
        For i = LBound(Headers()) To UBound(Headers())
            Cells(Row, 1 + i).Value = Headers(i)
        Next i
        Rows(Row).Font.Bold = True
'Loop here
    End If
Next Row

ActiveCell = ActiveCell.Offset(1, 0)
Loop Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))

Application.ScreenUpdating = True 'turn it back on



MsgBox ("Done!")

Answer 1

Is this what you are looking for?
I removed the activecell stuff and used range instead.
Also removed the do loop and only use the for loop.
I think it works but Not sure. It does not look like you have on your picture but I keept your text code.

Sub AddHeaders()

'Add headers below each section title
Dim Headers() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim LastRow As Long, Row As Long

Application.ScreenUpdating = False 'turn this off for the macro to run a


Set wb = ActiveWorkbook

LastRow = Cells(Rows.Count, 3).End(xlUp).Row
ActiveCell = Cells(1, 3)

Headers() = Array("Item", "Configuration", "Drawing/Document Number", "Title", "ECN", "Date", "Revisions")
' Set Do loop to stop when two consecutive empty cells are reached.

For Row = 1 To LastRow 'Add a loop to go through the cells in each row?
    If Range("C" & Row).Value = "" Then 'If row is empty, then go in and add headers
        For i = LBound(Headers()) To UBound(Headers())
            Cells(Row, 1 + i).Value = Headers(i)
        Next i
        Rows(Row).Font.Bold = True
'Loop here
    End If
Next Row



Application.ScreenUpdating = True 'turn it back on



MsgBox ("Done!")
End Sub

Edit; Include image of output of above code.