Copy Data From Sheet1 to Sheet2, Inserting Row When Value in Column Changes

user_16298669 0
Viewed 40

How can I use VBA to copy data from sheet1 to sheet 2, with a condition that if the value from column G changes, I insert a new row on sheet 2 below the row holding that last value but above the row holding the next value? Sample input is given, with sample output highlighting the inserted row. Getting all the right columns on the output sheet I can do myself, but the logic for the row insert is giving me trouble.

enter image description here

enter image description here


    Dim dataSheet As Worksheet
    Dim lastRow As Long, r As Long
    
    Set dataSheet = ActiveSheet 'Worksheets("Sheet1")
    
    With dataSheet
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For r = lastRow To 2 Step -1
        
        'compare current row column G to previous row column G, if not the same value, insert row between the two rows

                .Rows(r + 1).Resize(UBound + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next
vba excel
2 Answers

Insert Between Groups

Option Explicit

Sub InsertBetweenGroups()
    
    With ActiveSheet.Range("A1").CurrentRegion
        Dim rCount As Long: rCount = .Rows.Count
        Dim cCount As Long: cCount = .Columns.Count
        Dim r As Long
        For r = rCount To 2 Step -1
            With .Cells(r, "G")
                If .Value <> .Offset(1).Value Then
                    With .Offset(1).EntireRow.Resize(, cCount)
                        .Insert xlShiftDown, xlFormatFromLeftOrAbove
                        With .Offset(-1)
                            .Value = .Offset(-1).Value
                            .Columns("B").Value = "Data Remote..."
                            .Columns("G").Value = "Hardware"
                            .Columns("E:F").ClearContents
                            .Interior.Color = vbYellow
                        End With
                    End With
                End If
            End With
        Next r
    End With

End Sub
user_98140690

I have come up with a solution that seems to work for getting the desired output, but it is quite messy compared to @VBasic2008's. I use formulas to fill my empty rows on another sheet; for example:

Worksheets("InvoiceData").Range("V1").Value = "LineDescription"
Worksheets("InvoiceData").Range("V2").Formula2 = "=IF(ISBLANK(A2)=TRUE, ""Hardware"",E2)"

And the VBA to insert the rows:

Sub test()

    Dim lRow As Long
    
    'Create InvoiceData sheet to manipulate data
    Sheets.Add.Name = "InvoiceData"
    'Copy and Paste ABSData sheet as Values
        Sheets("ABSData").Cells.Copy
        Sheets("InvoiceData").Cells.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False

End Sub
user_162986690
Related