Search code examples
excelvbacopy-paste

VBA: Copying a row, inserting it above with one cell's value changed


I'm trying to find a way to copy the values of an identified row and insert it above with the same values except for one column. If possible, it would be great to find a way to change 2 cells in the identified row too. I'm completely new in trying to use VBA so I haven't gotten very far... currently I can insert a blank row, but with no contents. Hopefully to make it clearer, here are the steps I'm trying to complete.

  1. In column C, work through each row and identify/action each one that contains "ITEM1_ITEM2"
  2. Insert row above (or below?) the identified row containing all the same values, except for column C, which has the value changed to "ITEM2", and column H, which has its number value halved.
  3. The identified row has its column C value changed to "ITEM1" and its column H value is halved as well.
  4. Move on to the next identified row with "ITEM1_ITEM2" and complete the same.

Any help would be appreciated. I don't even need to complete all the steps... even just figuring out how to just copy/paste the cells in inserted row would help. Thanks!

Public Sub sortICs()

    Dim bottom As Long, top As Long
    Dim row As Long
    
    With ActiveSheet
        top = 1
        bottom = .UsedRange.Rows(.UsedRange.Rows.Count).row
            
        For row = bottom To top Step -1
            If .Range("C" & row).Value = "ITEM1_ITEM2" Then
                .Range("C" & row).EntireRow.Insert
            End If
        Next row
    End With
    
End Sub

Solution

  • This would work:

    Public Sub sortICs()
    
        Dim bottom As Long, top As Long
        Dim rw As Range, newRow As Range, x, i As Long
        
        With ActiveSheet.UsedRange
            For i = .Rows.Count To 2 Step -1  'work backwards so you don't interfere when inserting rows
                Set rw = .Rows(i)
                If rw.Columns("C").Value = "ITEM1_ITEM2" Then
                    rw.Offset(1, 0).Insert
                    Set newRow = rw.Offset(1, 0) 'the just-inserted row
                    rw.Copy newRow
                    
                    rw.Columns("C").Value = "ITEM1"
                    newRow.Columns("C").Value = "ITEM2"
                    
                    x = rw.Columns("H").Value / 2
                    rw.Columns("H").Value = x
                    newRow.Columns("H").Value = x
                End If
            Next i
        End With
        
    End Sub