Insert blank rows based on cell value

hello vba experts...

i have code for "insert blank rows between base on count of each rows" but does'nt perfectly work, see this below :

Code:

---

Sub muhammad_susanto()
'insert blank rows between base on count of each rows'
Dim LR As Long
Dim I As Long
Dim Ofst As Integer
LR = Cells(Rows.Count, "A").End(xlUp).Row
For I = LR To 1 Step -1
    Ofst = Cells(I, 1).Value
    Ofst = Ofst - 1
    If Ofst = 0 Then
        Else
        Cells(I + 1, 1).Resize(Ofst).EntireRow.Insert
        Cells(I, 2).Resize(Ofst + 1).Value = Cells(I, 2).Value
    End If
Next I
End Sub

---

it's error in the line :

Code:

---

Cells(I + 1, 1).Resize(Ofst).EntireRow.Insert

---

i appreaciated who want's help me...

regards...
muhammad susanto

your code works on my test sheet, attach a sample file with data and desired result

ok. if i execute at first code it's work, but more than/once again it's error..

Hi

Try

Code:

---

Sub muhammad_susanto()
    'insert blank rows between base on count of each rows'
    Dim LR As Long
    Dim I As Long
    Dim Rng As Range
   
    Dim Ofst As Integer
    LR = Cells(Rows.Count, "C").End(xlUp).Row
   
    Set Rng = Range("c16:c" & LR)
    With Rng
        For I = .Rows.Count To 1 Step -1
            Ofst = .Cells(I, 1).Value
            If Ofst > 0 Then
                Ofst = IIf(Ofst = 1, 1, Ofst - 1)
                .Cells(I + 1, 1).Resize(Ofst).EntireRow.Insert
                .Cells(I, 2).Resize(Ofst + 1).Value = .Cells(I, 2).Value
            End If
        Next I
    End With
End Sub

---

or

Code:

---

Sub M_snb()
    sn = Cells(13, 3).CurrentRegion.Offset(3)
    sp = Cells(13, 3).CurrentRegion.Offset(3).Resize(Application.Sum(Application.Index(sn, 0, 1)) + UBound(sn))
   
    For j = 1 To UBound(sn)
      c00 = c00 & "," & j & Replace(String(sn(j, 1), ","), ",", "," & UBound(sp))
    Next
   
    Cells(13, 3).CurrentRegion.Offset(3).ClearContents
    Cells(16, 3).Resize(UBound(sp), UBound(sp, 2)) = Application.Index(sp, Application.Transpose(Split(Mid(c00, 2), ",")), [transpose(row(1:10))])
End Sub

---

Thanks you, admin...it's realy work...

sorry, guys..i am a mistake..my code that's i want with criteria like this :

- base upon count of of each rows with assuming, if count of rows = 0 or 1, nothing inserted row;
- if count of rows >= 2, inserted row minus 1, for example :
count of row = 2.....result inserted row = 1
count of row = 3.....result inserted row = 2
count of row = 5.....result inserted = 4
etc....

i hope somebody would help me.

regards...
m.susanto

You can easily adapt the suggestions you received yourself.

Quote:

---

Originally Posted by muhammad susanto

sorry, guys..i am a mistake..my code that's i want with criteria like this :

- base upon count of of each rows with assuming, if count of rows = 0 or 1, nothing inserted row;
- if count of rows >= 2, inserted row minus 1, for example :
count of row = 2.....result inserted row = 1
count of row = 3.....result inserted row = 2
count of row = 5.....result inserted = 4
etc....

i hope somebody would help me.

regards...
m.susanto

---

That's what the code does, isn't it ?

your's code it's work normaly base upon count of each row,
i suggest that's code base upon with keep if amount of row = 0 or 1, nothing inserted rows, otherwise inserted rows minus 1 if amount of row greater than or equal to 2

1 -----title1
2 -----title2
------title2
3------title3
------title3
------title3
1------title4

Hi

replace

Code:

---

If Ofst > 0 Then
                Ofst = IIf(Ofst = 1, 1, Ofst - 1)
                .Cells(I + 1, 1).Resize(Ofst).EntireRow.Insert
                .Cells(I, 2).Resize(Ofst + 1).Value = .Cells(I, 2).Value
            End If

---

with

Code:

---

If Ofst > 1 Then
    .Cells(I + 1, 1).Resize(Ofst).EntireRow.Insert
    .Cells(I, 2).Resize(Ofst + 1).Value = .Cells(I, 2).Value
End If

---

it's not fully work...for base upon 0 or 1, it's work but for base upon greater than equal 2 is still wrong

should be :

2-------title1----not inserted
-------title1 ---inserted row
4-------title2---not inserted
-------title2---inserted row
-------title2---inserted row
etc...

would you help me....
thanks...admin

Hi

Code:

---

If Ofst > 1 Then
    .Cells(I + 1, 1).Resize(Ofst - 1).EntireRow.Insert
    .Cells(I, 2).Resize(Ofst + 1).Value = .Cells(I, 2).Value
End If

---

Quote:

---

Originally Posted by Admin

Hi

Code:

---

If Ofst > 1 Then
    .Cells(I + 1, 1).Resize(Ofst - 1).EntireRow.Insert
    .Cells(I, 2).Resize(Ofst + 1).Value = .Cells(I, 2).Value
End If

---

---

it's realy realy work 1000%....

thank you for the help...admin

you are the best......