Adding Rows & Copying Data in Row Above

[Wilconcl51]

I'm using Excel On Line
My spreadsheet has 2 columns. Colum A = Name ; Column B= Number
I'm using code to add rows below based on the Number in Column B. eg B = 2 then 2 rows inserted; B=3 then 3 rows inserted.
Code

Sub InsertRows() Dim i As Long, lRow As Long With ActiveSheet lRow = .Cells(.Rows.Count, 2).End(xlUp).Row For i = lRow To 1 Step -1 If IsNumeric(Cells(i,2)) Then .Rows(i + 1).Resize(Cells(i, 11)).Insert End If Next End With End Sub How can I change code to insert Rows and Copy Name in Row above to inserted Rows Many thanks

 

[mohadin]

Hi
Try this

Sub InsertRows()
    Dim i As Long, lRow As Long
    With ActiveSheet
        lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        For i = lRow To 1 Step -1
            If IsNumeric(Cells(i, 2)) Then
                .Rows(i + 1).Resize(Cells(i, 2)).Insert
                .Cells(i, 1).Copy .Cells(i + 1, 1).Resize(Cells(i, 2))
            End If
        Next
    End With
End Sub

 

[Wilconcl51]

Hi
Try this

Sub InsertRows()
    Dim i As Long, lRow As Long
    With ActiveSheet
        lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        For i = lRow To 1 Step -1
            If IsNumeric(Cells(i, 2)) Then
                .Rows(i + 1).Resize(Cells(i, 2)).Insert
                .Cells(i, 1).Copy .Cells(i + 1, 1).Resize(Cells(i, 2))
            End If
        Next
    End With
End Sub

Thank you.

Works really well on my test data using 12 rows . Not so good when I substantially increased the size of the sample data to 120 rows. Not sure why yet.

Garry

 

[kevin9999]

Not sure how this works with the online version, but please try the following with a copy of your workbook.

Option Explicit
Sub InsertRows()
    Dim s As String, i As Long, j As Long, k As Long, n As Long, a, b
    a = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    n = WorksheetFunction.Sum(Columns("B:B"))
    
    If n > 0 Then
        j = 1
        ReDim b(1 To UBound(a, 1) + n, 1 To 2)
        For i = 1 To UBound(a, 1)
            s = a(i, 1)
            b(j, 1) = s: b(j, 2) = a(i, 2)
            If IsNumeric(a(i, 2)) And a(i, 2) > 0 Then
                k = a(i, 2)
                For n = 1 To k + 1
                    b(j, 1) = a(i, 1): j = j + 1
                Next n
            Else
                j = j + 1
            End If
        Next i
        Range("A1").Resize(UBound(b, 1), 2) = b
    End If
End Sub

 

[Wilconcl51]

Not sure how this works with the online version, but please try the following with a copy of your workbook.

Option Explicit
Sub InsertRows()
    Dim s As String, i As Long, j As Long, k As Long, n As Long, a, b
    a = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    n = WorksheetFunction.Sum(Columns("B:B"))
   
    If n > 0 Then
        j = 1
        ReDim b(1 To UBound(a, 1) + n, 1 To 2)
        For i = 1 To UBound(a, 1)
            s = a(i, 1)
            b(j, 1) = s: b(j, 2) = a(i, 2)
            If IsNumeric(a(i, 2)) And a(i, 2) > 0 Then
                k = a(i, 2)
                For n = 1 To k + 1
                    b(j, 1) = a(i, 1): j = j + 1
                Next n
            Else
                j = j + 1
            End If
        Next i
        Range("A1").Resize(UBound(b, 1), 2) = b
    End If
End Sub

Thank you.
If I wanted to insert Rows only when Number in Column B is great than 1 what would I need to change

Garry

 

[kevin9999]

Easy:

Option Explicit
Sub InsertRows_V2()
    Dim s As String, i As Long, j As Long, k As Long, n As Long, a, b
    a = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    n = WorksheetFunction.Sum(Columns("B:B"))
    
    If n > 0 Then
        j = 1
        ReDim b(1 To UBound(a, 1) + n, 1 To 2)
        For i = 1 To UBound(a, 1)
            s = a(i, 1)
            b(j, 1) = s: b(j, 2) = a(i, 2)
            If IsNumeric(a(i, 2)) And a(i, 2) > 0 Then
                k = a(i, 2)
                For n = 1 To k
                    b(j, 1) = a(i, 1): j = j + 1
                Next n
            Else
                j = j + 1
            End If
        Next i
        Range("A1").Resize(UBound(b, 1), 2) = b
    End If
End Sub

 

[kevin9999]

I think this might be better:

Option Explicit
Sub InsertRows_V3()
    Dim s As String, i As Long, j As Long, k As Long, n As Long, a, b
    a = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    n = WorksheetFunction.Sum(Columns("B:B"))
    
    If n > 0 Then
        j = 1
        ReDim b(1 To UBound(a, 1) + n, 1 To 2)
        For i = 1 To UBound(a, 1)
            s = a(i, 1)
            b(j, 1) = s: b(j, 2) = a(i, 2)
            If IsNumeric(a(i, 2)) And a(i, 2) > 1 Then
                k = a(i, 2)
                For n = 1 To k + 1
                    b(j, 1) = a(i, 1): j = j + 1
                Next n
            Else
                j = j + 1
            End If
        Next i
        Range("A1").Resize(UBound(b, 1), 2) = b
    End If
End Sub

 

[Wilconcl51]

I think this might be better:

Option Explicit
Sub InsertRows_V3()
    Dim s As String, i As Long, j As Long, k As Long, n As Long, a, b
    a = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    n = WorksheetFunction.Sum(Columns("B:B"))
   
    If n > 0 Then
        j = 1
        ReDim b(1 To UBound(a, 1) + n, 1 To 2)
        For i = 1 To UBound(a, 1)
            s = a(i, 1)
            b(j, 1) = s: b(j, 2) = a(i, 2)
            If IsNumeric(a(i, 2)) And a(i, 2) > 1 Then
                k = a(i, 2)
                For n = 1 To k + 1
                    b(j, 1) = a(i, 1): j = j + 1
                Next n
            Else
                j = j + 1
            End If
        Next i
        Range("A1").Resize(UBound(b, 1), 2) = b
    End If
End Sub

Hi kevin9999,

Excellent. Works perfectly
Thank you so much

Garry

 

[kevin9999]

Happy to help, and thanks for the feedback

 

[Wilconcl51]

Happy to help, and thanks for the feedback

Hi kevin9999,

If I had a brain I would be dangerous.

Your code works perfectly as I said. My logical is not working.
When Column B shows 2 then I only want to add one extra Row to have two rows, when number is 3 then I only need 2 additional rows inserted

The rows to insert really needs to be 1 less that the Number in Column B.

Sorry

Garry