VBA macro to merge duplicate rows based on multiple values in a row

Question

I have a sample MS Excel table:

I am trying to write a VBA macro that would allow me to compare rows, the comparison is done using multiple cells(A2:E2), and the rest of the cells(F2:I2) would merge its values without comparison. I would like to be able to compare one row - cells(A2:E2) to cells(A3:E3), then cells(A2:E2) to cells(A4:E4)... when it is done comparing it would merge the duplicates - so that cells(Fx:Ix) would merge as well.

The final effect would look like this:

So far I have came up with this code, but running it crashes Excel. Any kind of advice would be much appreciated.

Thanks in advance

Sub MergeDuplicateRows()

    Dim i As Long
    Dim j As Long
    Dim RowCount As Long

    Dim sameRows As Boolean

    sameRows = True
    RowCount = Rows.Count

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For i = 1 To Range("B" & RowCount).End(xlUp).Row
        For j = 1 To 5
            If StrComp(Cells(i, j), Cells(i + 1, j), vbTextCompare) Then
                sameRows = False
            End If
        Next j

        If sameRows Then
            Range(Cells(i, 1), Cells(i + 1, 1)).Merge
            Range(Cells(i, 2), Cells(i + 1, 2)).Merge
            Range(Cells(i, 3), Cells(i + 1, 3)).Merge
            Range(Cells(i, 4), Cells(i + 1, 4)).Merge
            Range(Cells(i, 5), Cells(i + 1, 5)).Merge
            Range(Cells(i, 6), Cells(i + 1, 6)).Merge
            Range(Cells(i, 7), Cells(i + 1, 7)).Merge
            Range(Cells(i, 8), Cells(i + 1, 8)).Merge
            Range(Cells(i, 9), Cells(i + 1, 9)).Merge
        End If

        sameRows = True
    Next i

    Application.DisplayAlerts = True

End Sub

In your final result, why does var8 have an x in the row for foo1 (with no M)? — dwirony
– dwirony, Commented Jan 7, 2019 at 18:22
"...but running it crashes Excel" - what do you mean by this? Are you getting an actual error message, or is Excel just freezing? — dwirony
– dwirony, Commented Jan 7, 2019 at 18:24
excel just freezes and never wakes up - a dialog box comes up asking to restart MS Excel... — Saint
– Saint, Commented Jan 7, 2019 at 18:25
Last question - are all the rows that could possibly matchup right on top/below each other, or could they be anywhere on the worksheet? — dwirony
– dwirony, Commented Jan 7, 2019 at 18:25

dwirony · Accepted Answer · 2019-01-07 18:42:45Z

5

Give this a shot - I had to change around some logic, change your For loop to a Do While loop, and instead of merging we're just deleting rows instead. I tested this on your sample data and it worked alright, I'm not sure how it will perform on 1500 rows, though:

Sub MergeDuplicateRows()

    Dim i As Long
    Dim j As Long
    Dim sameRows As Boolean

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    i = 2

    Do While Cells(i, 2).Value <> ""
        For j = 1 To 5
            If Cells(i, j).Value <> Cells(i + 1, j).Value Then
                sameRows = False
                Exit For
            Else
                sameRows = True
            End If
        Next j

        If sameRows Then
            If Cells(i, 6).Value = "" Then Cells(i, 6).Value = Cells(i + 1, 6).Value
            If Cells(i, 7).Value = "" Then Cells(i, 7).Value = Cells(i + 1, 7).Value
            If Cells(i, 8).Value = "" Then Cells(i, 8).Value = Cells(i + 1, 8).Value
            If Cells(i, 9).Value = "" Then Cells(i, 9).Value = Cells(i + 1, 9).Value

            Rows(i + 1).Delete
            i = i - 1
        End If

        sameRows = False
        i = i + 1
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

answered Jan 7, 2019 at 18:42

dwirony

5,4604 gold badges26 silver badges49 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

Saint Over a year ago

Many thanks - works like a charm with a small data set; takes a while with ~1500 - and at least I can see where i was going wrong with my logic :). Appreciate the help.

Collectives™ on Stack Overflow

VBA macro to merge duplicate rows based on multiple values in a row

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related