Insert rows based on cell value and swap cells

Question

I am working on a project to do the following.

Data I get from ERP:

After running the code it should look like:

I want to implement this logic

• If there is a value greater than 0 in the 'I' column and column 'K' is 0
  • Add row that swaps the values in cell 'F' and 'G' with those in 'H' and 'I'.
• If the number is greater than 0 in both columns
  • Add two rows and the cells should be swapped around.

My current code.

Sub = Duplicate Rows()
    Dim colOne As New Collection, colTwo As New Collection
    Dim v1, v2, c As Range, rw As Range, nr As Range

    For Each rw In Range("A2:Z9999").Rows
        v1 = rw.Columns("I").Value
        v2 = rw.Columns("K").Value
        If v1 > 0 And v2 > 0 Then
            colTwo.Add rw.Cells(1)
        ElseIf v1 > 0 Then
            colOne.Add rw.Cells(1)
        End If
        
    Next rw
    
    Set nr =
    
    For Each c In colTwo
        nr = c.EntireRow.Copy
        c.Resize(2).nr.Insert
    Next c
    For Each c In colOne
        nr = c.EntireRow.Copy
        c.nr.Insert
    Next c
   
End Sub

Answer 1

Something like this should work:

Sub DuplicateRows()
    Dim i As Long, ws As Worksheet
    Dim v1, v2, c As Range, rw As Range, nr As Range, rwIns As Range
    
    Set ws = ActiveSheet                       'or whatever
    For i = 9999 To 2 Step -1                  'looping *backwards* through rows
        Set rw = ws.Cells(i, 1).Resize(1, 26)  'the row to process
        If Application.CountA(rw) > 0 Then     'row has data?
            
            v1 = rw.Columns("I").Value
            v2 = rw.Columns("K").Value
            
            If v1 > 0 Then
                rw.Offset(1, 0).Insert
                With rw.Offset(1, 0)
                    rw.Copy .Cells       'copy contents
                    .Columns("F").Value = rw.Columns("H").Value 'swap values...
                    .Columns("G").Value = rw.Columns("I").Value
                    .Columns("H").Value = rw.Columns("F").Value
                    .Columns("I").Value = rw.Columns("G").Value
                    .Font.Color = vbRed 'highlight inserted row
                End With
            End If
            
            If v1 > 0 And v2 > 0 Then       'adding a second row?
                rw.Offset(1, 0).Insert
                With rw.Offset(1, 0)
                    rw.Copy .Cells          'copy contents
                    'swap values as above...
                    .Font.Color = vbRed 'highlight inserted row
                End With
            End If
        End If            'row has content
    Next i
End Sub