Sub addHeadingsToDatabase()
' Add a column to the left of the currently selected headings.
' Then add a heading to this range every time the heading text changes.
' This can be used to make a database easier to read.
'
' For instance:
' Year 3 | Trevor
' Year 3 | Joe
' Year 4 | Madeline
'
' becomes:
' Year 3 | |
' | Year 3 | Trevor
' | Year 3 | Joe
' Year 4 | |
' | Year 4 | Madeline
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim lastRow As Long
Dim i As Long
On Error GoTo quit
Set rng = Application.InputBox("Select the range to add a headings to:", "Compare Cells", Application.Selection.Address, Type:=8)
On Error GoTo 0
' Insert a column to the left of the range
rng.EntireColumn.Insert Shift:=xlToRight
' Loop through the range from bottom to top
lastRow = rng.Rows.Count
For i = lastRow To 2 Step -1
If rng.Cells(i, 1).Value <> rng.Cells(i - 1, 1).Value Then
' Insert a row above
rng.Cells(i, 1).EntireRow.Insert Shift:=xlDown
' Copy the text to the cell one above and one left
rng.Cells(i, 0).Value = rng.Cells(i + 1, 1).Value
End If
Next i
quit:
End Sub