Inserting the same header to multiple rows of a spreadsheet

[Rick G]

Hi:

I'm currently running Excel version 2003.

My spreadsheet has approx. 15,000 rows and 15 columns with corresponding headings.
One of the column headings is used to identify the catalog page number of an item. Many items appear on the same catalog page #. Not every page number contains the same amount of items. All of the page numbers are sorted in ascending order.

I would like insert a new row into the spreadsheet for every change in page number and automatically copy the same headings from row 1 into each newly added row of the spreadsheet.

I have little to no knowledge on how to write this formula and the catalog contains 2144 pages. Can you help me please?

I really don't have time to manually perform this task.

Thank you.

 

[JoeMo]

Here's a macro that you can try on a copy of your workbook. I assumed that your first heading is in cell A1 and the page # heading is in column C (column number 3). Change these to fit your situation.

Sub InsertHeaders()
Dim rng As Range, pgColNum As Long, lRw As Long

pgColNum = 3  'Change this to the number of the column that has page # heading
lRw = Cells(Rows.Count, pgColNum).End(xlUp).Row
Set rng = Range(Cells(2, 1), Cells(lRw, 15))
For i = lRw - 1 To 2 Step -1
    If Cells(i, pgColNum).Value <> Cells(i, pgColNum).Offset(1, 0).Value Then
        Cells(i, pgColNum).Offset(1, 0).EntireRow.Insert
        rng.Rows(i).Value = rng.Rows(1).Offset(-1, 0).Value
    End If
Next i
End Sub

 

[Rick G]

Fantastic! It works beautifully (in about 3 seconds!!!!).

One item I failed to mention in my original posting (and is not a big deal) is that when the header row is copied automatically at each page # change via the macro, I was wondering if it would be possible to have all newly created "header rows" shaded in a light grey color.

Can this be done without too much difficulty? If not, it can be done manually with little to no effort. I don't want to bother you unnecessarily and really appreciate the help you have provided me with the code you wrote below.

Thank you so much!

Rick

 

[JoeMo]

This should fill the new headers with light grey and run a bit faster too. Don't forget to alter the pgColNum to fit your data.

Sub InsertHeaders()
Dim rng As Range, pgColNum As Long, lRw As Long

Application.ScreenUpdating = False
pgColNum = 3  'Change this to the number of the column that has page # heading
lRw = Cells(Rows.Count, pgColNum).End(xlUp).Row
Set rng = Range(Cells(2, 1), Cells(lRw, 15))
For i = lRw - 1 To 2 Step -1
    If Cells(i, pgColNum).Value <> Cells(i, pgColNum).Offset(1, 0).Value Then
        Cells(i, pgColNum).Offset(1, 0).EntireRow.Insert
        With rng.Rows(i)
            .Value = rng.Rows(1).Offset(-1, 0).Value
            .Interior.Color = RGB(220, 220, 220)  'Increase the 220's upward to lighten fill
        End With
    End If
Next i
End Sub

 

[Rick G]

Perfect!

Thank you so much for tweaking this code for me!

Take care,

Rick