Question

Situation: I have data that I am trying to consolidate by summing rows based on the first column value (item ID number). If the ID numbers match I want the rows to be added together and the duplicate rows deleted.

I have written the following code and I am experiencing 2 issues: 1. The first time I run the code there is always a few duplicates left that were not consolidated 2. If I run the code again it sums and deletes rows even if they are not duplicates.

Any help would be much appreciated.

Sub ConsolidateRows()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim iRow As Long
    Dim iCol As Long
    Dim LastRow As Long
    Dim LastCol As Long
    Dim duplicate As String
    Dim dupRow As Long
    Dim cell As Range
    Dim i As Integer

   'set
    Set WB = Workbooks("Book1")
    Set WS = WB.Sheets("Data")
    LastRow = WS.UsedRange.Rows.Count
    LastCol = WS.UsedRange.Columns.Count

    'Loop to consolidate, delete the duplicate rows
    iRow = 1
    While WS.Cells(iRow, 1).Value <> ""
        duplicate = Cells(iRow, 1).Value
        iRow = iRow + 1

        For Each cell In WS.Range("A1:A" & LastRow).Cells
                dupRow = cell.Row

            If cell.Value = duplicate And iRow <> dupRow Then
                For iCol = 3 To LastCol
                        Cells(iRow, iCol) = Application.WorksheetFunction.Sum(Cells(iRow, iCol), Cells(dupRow, iCol))
                Next iCol
                WS.Rows(dupRow).Delete
            End If
        Next cell
    Wend
End Sub

Answer 1

When deleting rows, always start at the bottom and work your way up.

For example if Column A for rows 1-5 contain:

Alpha
Bravo
Charlie
Delta
Foxtrot

and you delete row 3, you now have

Alpha
Bravo
Delta
Foxtrot

Your loop counter (value 3) was pointing at Charlie before the deletion, but is now pointing at Delta, you then increment your counter to 4, and it's pointing at Foxtrot, therefore you never evaluated whether you needed to delete Delta.

Try this:

'Loop to consolidate, delete the duplicate rows
iRow = LastRow
While WS.Cells(iRow, 1).Value <> ""
    duplicate = Cells(iRow, 1).Value
    iRow = iRow - 1

    For Each cell In WS.Range("A1:A" & LastRow -1).Cells
            dupRow = cell.Row

        If cell.Value = duplicate And iRow <> dupRow Then
            For iCol = 3 To LastCol
                    Cells(iRow, iCol) = Application.WorksheetFunction.Sum(Cells(iRow, iCol), Cells(dupRow, iCol))
            Next iCol
            WS.Rows(dupRow).Delete
            LastRow = LastRow - 1
        End If
    Next cell
Wend

^{*Note: code changes off the top of my head, you may have to make some minor additional tweaks to get it running backwards}

Also, please investigate .Find() - it will make your code run significantly faster for finding dups.

Wrong Rows Deleted in Consolidation Loop

1 个答案: