Inserting blank rows in a numbered list

[osbak]

Hi - hope you can help . . . I've got some data relating to 1800 individuals, each represented as a row. The way the data has come to me, however, means that for some questions, where a response was not given, I don't have a row. For instance, I'm currently looking at something which starts with the following numbers in the first column: 6, 7, 8, 10, 17, 28, 48, etc etc.

I want to insert blank rows (e.g. 1-5, 9, 11-16, 18-27, 29-47, etc) so that the data can be more easily manipulated in e.g. SPSS. Any clues on how to do this automatically rather than going through it manually?!

Grateful for any tips for someone who's feeling a bit rusty on excel . . .

 

[dermie_72]

this code might help.

It's not the prettiest code, but it should do the job.

Sub osbak()
'Inserting blank rows in a numbered list
'http://www.mrexcel.com/forum/excel-questions/682862-inserting-blank-rows-numbered-list.html
Dim A As Long
Dim I As Range
Dim LR As Long, counter As Long, check As Long

LR = ActiveSheet.UsedRange.Rows.Count
counter = 2
Range("A1").Select
check = ActiveCell
Range("A2").Select
Do While counter < LR
    If ActiveCell = check + 1 Then
        ActiveCell.Offset(1, 0).Select
        check = check + 1
        Else: ActiveCell.EntireRow.Insert
        ActiveCell.Offset(1, 0).Select
        check = check + 1
        LR = LR + 1
    End If
    counter = counter + 1
Loop

End Sub

 

[Tom Urtis]

One way, if the data starts on row 1 (the number in cell A1 does not need to be 1, just that the data starts on that row). It wasn't clear to me if the data starts on row 1 or if row 1 contains header labels.

Sub Test1()
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