Insert new row, help

[Babi_mn]

I have 23019 row in my B column, and some of them are blank.
I want to add new blank row below each and every row except blank cells. Please help
PS i attached screenshot below (Column A is just numeric orders, ignore it please)

 

[Babi_mn]

OK, see if this does what you want. If it doesn't, then I'll need to see a before-and-after sample before I can progress any further.

Option Explicit
Sub Insert_Rows_V2()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<-- *** Change to actual sheet name ***
    Dim LRow As Long, LCol As Long, i As Long, j As Long
    LRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
   
    Dim a, b
    a = ws.Range(ws.Cells(2, 1), ws.Cells(LRow, 1))
    ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1) ' - 1
            b(i, 1) = j + 1
            j = j + 1
    Next i
    ws.Cells(2, LCol).Resize(UBound(b, 1), 1).Value = b
    LRow = ws.Cells(Rows.Count, LCol).End(xlUp).Row + 1
    ws.Cells(LRow, LCol).Resize(UBound(b, 1), 1).Value = b
   
    LRow = ws.Cells(Rows.Count, LCol).End(xlUp).Row
    ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
    order1:=xlAscending, Header:=xlNo
    ws.Columns(LCol).EntireColumn.ClearContents
    Application.ScreenUpdating = False
End Sub

not working, showing random numbers sir

 

[Babi_mn]

Try this on a copy of your data.

Make sure that the sheet is active.

Private Sub subInsertBlankRow()
Dim i As Integer
Dim lngLastRow  As Long
   
    With ActiveSheet
        lngLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
       
    For i = lngLastRow To 2 Step -1
        If Len(Cells(i, 2).Value) > 0 Then
            Cells(i, 2).Offset(1, 0).EntireRow.Insert
        End If
    Next i

End Sub

i did but cant run this module

 

[Herakles]

i did but cant run this module

Why not?

 

[Babi_mn]

Why not?

after close VBA, i cant see my module on macros section

 

[kevin9999]

not working, showing random numbers sir

OK, I don't understand what that means, so I'll go back to:

If it doesn't, then I'll need to see a before-and-after sample before I can progress any further.

 

[Herakles]

after close VBA, i cant see my module on macros section

Change this line :

Private Sub subInsertBlankRow()

to this line:

Public Sub subInsertBlankRow()

 

[kevin9999]

When I run the code from post # 9, the data goes from this:

Insert rows.xlsm
	A	B
1	HDR1	HDR2
2	1	4
3	2	2
4	3	1
5	4	2
6	5	2
7	6	4
8	7	1
9	8	2
10	9	1
11	10	5
12	11
13	12	3
14	13	1
15	14	9
16	15	5
17	16	6
18	17	2
19	18	2
20	19	4
21	20
22	21
23	22	2
24	23	7
25	24	1
26	25	5
Sheet1

To this:

Insert rows.xlsm
	A	B
1	HDR1	HDR2
2	1	4
3
4	2	2
5
6	3	1
7
8	4	2
9
10	5	2
11
12	6	4
13
14	7	1
15
16	8	2
17
18	9	1
19
20	10	5
21
22	11
23
24	12	3
25
26	13	1
27
28	14	9
29
30	15	5
31
32	16	6
33
34	17	2
35
36	18	2
37
38	19	4
39
40	20
41
42	21
43
44	22	2
45
46	23	7
47
48	24	1
49
50	25	5
Sheet1

If this is not correct, then you need to explain what it should look like.