Insert and copy rows based on cell value using VBA - vba

Question

I have this table:
Quantity Name
1 A
3 C1
3 C2
4 D
I'm trying to make this table change to:
Quantity Name
1 A
1 A
3 C1
3 C1
3 C1
3 C2
3 C2
3 C2
4 D
4 D
4 D
4 D
But the result is not as expect: Result
Pls help my solve this problem.
Thanks!
Here is my code:
Sub newrow()
Dim xRg As Range
Dim xAddress As String
Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select a range to use(single column):", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRg(1).End(xlDown).Row
xFstRow = xRg.Row
xCol = xRg.Column
xCount = xRg.Count
Set xRg = xRg(1)
For I = xLastRow To xFstRow Step -1
xNum = Cells(I, xCol)
If IsNumeric(xNum) And xNum > 0 Then
Rows(I + 1).Resize(Cells(I, xCol) - Cells(I - 1, xCol)).Insert
xCount = xCount + xNum
End If
Next
xRg.Resize(xCount, 1).Select
Application.ScreenUpdating = True
End Sub

Answer 1

First of all …
If you Dim xFstRow, xCol, xCount As Long then only xCount is of type Long all the others are of type Variant. You need to specify a type for every variable!
Dim xFstRow As Long, xCol As Long, xCount As Long
Don't ever use On Error Resume Next without proper error handling. This only hides error messages but the errors still occur you just cannot see them. Therefore you cannot debug/fix your code. Remove it completely or implement a complete error handling instead.
You need to copy the row before you insert, otherwise you just insert empty rows.
I suggest the following code:
Option Explicit
Public Sub AddRowsFromQantities()
Dim SelAddress As String
SelAddress = ActiveWindow.RangeSelection.Address
Dim SelRange As Range
Set SelRange = Application.InputBox("Select a range to use(single column):", "KuTools For Excel", SelAddress, , , , , 8)
Dim fRow As Long
fRow = SelRange.Row 'first row of selected rang
Dim lRow As Long
lRow = fRow + SelRange.Rows.Count - 1 'last row of selected range
'find last used row within the selected range
If Cells(Rows.Count, 1).End(xlUp).Row < lRow Then
lRow = Cells(Rows.Count, 1).End(xlUp).Row
End If
Application.ScreenUpdating = False
Dim iRow As Long
For iRow = lRow To fRow Step -1
If IsNumeric(Cells(iRow, 1)) Then
Dim Quantity As Long
Quantity = Cells(iRow, 1).Value
If Quantity > 1 Then
Rows(iRow).Copy
Rows(iRow).Resize(RowSize:=Quantity - 1).Insert
End If
End If
Next iRow
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub