Tom’s Tutorials For Excel: Inserting Numbered Rows of Varying Increments

Tom’s Tutorials For Excel: Inserting Numbered Rows of Varying Increments

As any Excel VBA guru of the workplace knows, it’s you who gets called upon to make sense of whacky downloaded data.

Here, your company’s data warehouse shoots out a file with numbered records in column A that vary because some records are empty. Your job is to fill in the missing record numbers with inserted rows, as seen in the next picture of side-by-side Before and After screen shots.

There might be tens of thousands of these records, so a macro will be most practical. The first pictured example deals with row 1 being used for a header label.

Sub InsertNumberRowsWithHeaderRow1()
Application.ScreenUpdating = False
Dim xNumber&, xRow&, xDiff%, LastRow&
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For xRow = LastRow To 3 Step -1
If Cells(xRow, 1).Value <> Cells(xRow - 1, 1).Value Then
xDiff = Cells(xRow, 1).Value - Cells(xRow - 1, 1).Value - 1
If xDiff > 0 Then Rows(xRow).Resize(xDiff).Insert
End If
xDiff = Range("A2").Value
Next xRow
If xDiff > 1 Then Rows(2).Resize(xDiff - 1).Insert
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("A2:A" & LastRow)
.FormulaR1C1 = "=ROW()-1"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub

The next macro applies to the following pictured circumstance when no header row is used; that is, the actual data starts on row 1.

Sub InsertNumberRowsNoHeader()
Application.ScreenUpdating = False
Dim xNumber&, xRow&, xDiff%, LastRow&
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
For xRow = LastRow To 2 Step -1
If Cells(xRow, 1).Value <> Cells(xRow - 1, 1).Value Then
xDiff = Cells(xRow, 1).Value - Cells(xRow - 1, 1).Value - 1
If xDiff > 0 Then Rows(xRow).Resize(xDiff).Insert
End If
xDiff = Range("A1").Value
Next xRow
If xDiff > 1 Then Rows(1).Resize(xDiff - 1).Insert
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
With Range("A1:A" & LastRow)
.FormulaR1C1 = "=ROW()"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub
Share Button
Posted in Tom's Tutorials for Excel
Tags: , , , , , , , , , , ,

Leave a Reply

Your email address will not be published.

*