Insert blank rows based on cell value

[muhammad susanto]

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 :


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 :

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

i appreaciated who want's help me...

regards...
muhammad susanto

[patel]

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

[muhammad susanto]

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

[Admin]

Hi

Try


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

[snb]

or

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

[muhammad susanto]

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

[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

[snb]

You can easily adapt the suggestions you received yourself.

[Admin]

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 ?

[muhammad susanto]

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

[Admin]

Hi

replace


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


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

[muhammad susanto]

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

[Admin]

Hi


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

[muhammad susanto]

Hi


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......