Insert blank rows based upon cell value with criteria

[susanto]

hello vba experts...

i have code for "insert blank rows between base on count of each rows", 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 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





how to easily adapt with criteria this below :

- 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.. i'am a newbie...

regards...
m.susanto

[patel]

crosspost with http://www.excelfox.com/forum/f2/insert-blank-rows-based-on-cell-value-1427/