Insert multiple rows depends on cell value is getting error

[dharmadme]

Hi Friends,

I am trying to add insert rows using macro.
L column fills with numbers. if L1 value is 5 then below need to insert 5 rows.
I tried below Macro.
But it getting Error.
Please solve this and let me know whats wrong in it


Sub InsertRowswork1()

Dim LastNumber As Long: LastNumber = ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row
While LastNumber >= 2
If Not IsEmpty(ActiveSheet.Range("L" & LastNumber)) Then
Dim NewRows As Long: NewRows = ActiveSheet.Range("L" & LastNumber).Value
Dim InsertIndex As Long: InsertIndex = 1
While InsertIndex <= NewRows
ActiveSheet.Range("L" & LastNumber + 1).EntireRow.Insert
InsertIndex = InsertIndex + 1
Wend
End If
LastNumber = LastNumber - 1
Wend

End Sub

 

[Peter_SSs]

If you are getting an error in code, you should always state the error, what line it is on and preferably give a small set of sample data that causes the error to occur.

I just ran your code on a smalls set of data I made up and got no error so I have nothing to go on to help you.

 

[dharmadme]

Thanks for your response Peter

I got an error on highlighted row.
Hints says NewRows = 0 LastNumber = 106 which are not have any data
Then I found hidden values are there in my sheet. thats the reason Last number went to empty rows which are not containing any data
is that problem?
how can i remove hidden values in cells and change if any bugs in below code


Sub InsertRowswork1()

Dim LastNumber As Long: LastNumber = ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row
While LastNumber >= 2
If Not IsEmpty(ActiveSheet.Range("L" & LastNumber)) Then
Dim NewRows As Long: NewRows = ActiveSheet.Range("L" & LastNumber).Value
Dim InsertIndex As Long: InsertIndex = 1
While InsertIndex <= NewRows
ActiveSheet.Range("L" & LastNumber + 1).EntireRow.Insert
InsertIndex = InsertIndex + 1
Wend
End If
LastNumber = LastNumber - 1
Wend

End Sub

 

[dharmadme]

SOLVED: Insert multiple rows depends on cell value is getting error

Thanks for your support.

I have solved this myself using below code

Sub Autofilterwork1()

Dim MyCell, Rng As Range
Set Rng = Range("L:L")
For Each MyCell In Rng
    If MyCell Like "=" Then
  
Call Eraseemptycells
  
Else

Call InsertRowswork1

End If
Next

End Sub
Sub Eraseemptycells()
      Dim rng1 As Range

Set rng1 = Columns(12)
With rng1
    .AutoFilter Field:=12, Criteria1:="="
    With rng1.Offset
        .ClearContents
        .ClearComments
    End With
    With rng1.Offset(0, -1)
        .ClearContents
        .ClearComments
    End With
End With

Call InsertRowswork1

End Sub
Sub InsertRowswork1()

    Dim LastNumber As Long: LastNumber = ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row
    While LastNumber >= 2
        If Not IsEmpty(ActiveSheet.Range("L" & LastNumber)) Then
            Dim NewRows As Long: NewRows = ActiveSheet.Range("L" & LastNumber).Value
            Dim InsertIndex As Long:    InsertIndex = 1
            While InsertIndex <= NewRows
                ActiveSheet.Range("L" & LastNumber + 1).EntireRow.Insert
                InsertIndex = InsertIndex + 1
            Wend
        End If
        LastNumber = LastNumber - 1
    Wend

End Sub

 

[Peter_SSs]

Re: SOLVED: Insert multiple rows depends on cell value is getting error

I have solved this myself ..

Great news!