Insert and duplicate rows based on numerical value -1 in column

[Amatu]

Hello! I would greatly appreciate assistance in finding a solution in the excel ribbon or a VBA Code to automate the following task. I am creating a spreadsheet that is a download of all purchases that I have made for my music store since opening 6 years ago. Each row represents 1 item on a PO and the data related to that item (including Purchase Order #, Item #, Quantity ordered, cost per item, extended cost, etc). I am manually inserting a varied Number of blank rows based on the Quantity Value less 1 in row "M" and then copying the data from that row in the blank row(s). I need this macro to work on all 16,074 lines of data. Can you help me automate this function?

 

[alansidman]

Option Explicit

Sub InsertRows()
    Dim i As Long, lr As Long
    Dim crit As Integer
    lr = Range("M" & Rows.Count).End(xlUp).Row
    For i = lr To 1 Step -1
        crit = Range("M" & i).Value - 1
        If Range("M" &  i) <> 1 Then
            Range("A" & i).EntireRow.Offset(1).Resize(crit).Insert Shift:=xlDown
            Range("A" & i).EntireRow.Copy Range("A" & i).EntireRow.Offset(1).Resize(crit)
        End If
    Next i


End Sub

 

[Amatu]

Please excuse my ignorance - my first time looking at VBA. I have set up a Command Button on my Spreadsheet that, I hope, when i click it, it will run the macro. Therefore, do I paste this CODE between the two commands on the code form?

Below is what i see before pasting the code:


Private Sub CommandButton1_Click()


End Sub

 

[alansidman]

Yes, but delete the first line of my code beginning with Sub and delete the last line of code End Sub