How to get alternate blank row

[ThrottleWorks]

Hi,

I have a table, for example, 10 columns and 20 rows.

First row consist of headers. After header row, I want to insert one blank row before every non blank row.

So, the output will have alternate blank rows in the table. How do I do this.
Can anyone please help me this.

 

[xlstime]

I am not very much good in VBA, but this will help you

Sub rr()
k = 1
iL = Range("a1").End(xlDown).Row
For Each i In Range("a1:a" & Range("a10000").End(xlUp).Row)
Rows(i.Offset(k, 0).Row).Select
Selection.Insert Shift:=xlDown
k = k + 1
Next i
Range("a1").Select
End Sub

Hi,

I have a table, for example, 10 columns and 20 rows.

First row consist of headers. After header row, I want to insert one blank row before every non blank row.

So, the output will have alternate blank rows in the table. How do I do this.
Can anyone please help me this.

 

[xlstime]

Try this one


Sub a()

iL = Range("a65556").End(xlUp).Row
Range("a1").Select
i = 1
Do Until i > iL
If ActiveCell.Value = "" Then
x = ActiveCell.End(xlDown).Offset(1, 0).Row
Else
x = ActiveCell.Offset(1, 0).Row
'MsgBox x
End If
Rows(x).Select
Selection.Insert Shift:=xlDown

If i = WorksheetFunction.CountA(Range("a1:a" & Range("a65560").End(xlUp).Row)) Then Exit Do

i = i + 1

Loop

End Sub

I am not very much good in VBA, but this will help you

Sub rr()
k = 1
iL = Range("a1").End(xlDown).Row
For Each i In Range("a1:a" & Range("a10000").End(xlUp).Row)
Rows(i.Offset(k, 0).Row).Select
Selection.Insert Shift:=xlDown
k = k + 1
Next i
Range("a1").Select
End Sub

 

[ThrottleWorks]

Hi @xlstime , thanks for the help. I am checking this and will revert with details. Have a nice day ahead.

 

[jindon]

No loop

Sub test()
    Columns(1).Insert
    With Range("b2", Range("b" & Rows.Count).End(xlUp))
        On Error Resume Next
        .SpecialCells(4).EntireRow.Delete
        With .Offset(1, -1)
            .Formula = "=if(b3<>"""",if(a2=1,""a"",1),"""")"
            .Value = .Value
            .SpecialCells(2, 1).EntireRow.Insert
            .SpecialCells(2, 2).EntireRow.Insert
        End With
    End With
    Columns(1).Delete
End Sub

 

[ThrottleWorks]

Hi @jindon , sorry for late reply, I am checking this and will revert with details. Have a nice weekend.