Comparing rows without comparing each cell separately

[bukimi]

Hello!

I have a database, which is far too big and it can be compacted, because one column is not needed, but I need to sum the values in some other columns in it to delete whole rows.

Example:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Product[/TD]
[TD]Product_ID[/TD]
[TD]Buyer[/TD]
[TD]Date[/TD]
[TD]Items[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]12340[/TD]
[TD]CompanyA[/TD]
[TD]03-10-2017[/TD]
[TD]3[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]22415[/TD]
[TD]CompanyA[/TD]
[TD]03-10-2017[/TD]
[TD]2[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]Apples[/TD]
[TD]31911[/TD]
[TD]CompanyA[/TD]
[TD]03-10-2017[/TD]
[TD]7[/TD]
[TD]60[/TD]
[/TR]
</tbody>[/TABLE]

From these 3 rows I need only 1. I can leave them all, but these duplicates make my file too big for some purposes.
One, final (compressed) row would look like this:
Apples | 12340 | CompanyA | 03-10-2017 | 12 | 81

One column (Product ID here) is meaningless actually and it can take value of any of compressed rows, first one, or any of them.
Two columns have values that need to be added into a sum for a new row (here: 3 + 2 + 7 for Items and 9 + 12 + 60 for Value).

Sometimes there are 2 duplicate rows, sometimes even 15 or more.
They have all columns the same, except one and of course values.

I can add it by comparing every cell with "If" statement in VBA...

For i = 2 To NumberOfRows
    If .Cells(i, 1) = .Cells(i - 1, 1) And .Cells(i, 3) = .Cells(i - 1, 3) And .Cells(i, 4) = .Cells(i - 1, 4) Then
        .Cells(i - 1, 5).Value = .Cells(i - 1, 5).Value + .Cells(i, 5).Value 'adds items from duplicate row to row above
        .Cells(i - 1, 6).Value = .Cells(i - 1, 6).Value + .Cells(i, 6).Value 'adds value from duplicate row to row above
        Rows(i).EntireRow.Delete 'deletes duplicated row
        i = i - 1 'moves loop one item back to avoid skipping a row after deleting it
    End If
Next i

... but I have many columns (A-O) and that "If" statement would be very big, too Any way to compress these columns by other means? Maybe even other than VBA?
I can't just use Pivot Table, because I need that database in this exact format unchanged, not only a sum of Items and Value.

Thank you in advance for your help.

 

[wideboydixon]

You could use a helper function something like this:

Public Sub CompressRows()

Dim lastRow As Long
Dim thisRow As Long

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
thisRow = 1
Do While thisRow < lastRow
    If RowsMatch(thisRow) Then
        Cells(thisRow, 5).Value = Cells(thisRow, 5).Value + Cells(thisRow + 1, 5).Value
        Cells(thisRow, 6).Value = Cells(thisRow, 6).Value + Cells(thisRow + 1, 6).Value
        Rows(thisRow + 1).EntireRow.Delete
        lastRow = lastRow - 1
    Else
        thisRow = thisRow + 1
    End If
Loop

End Sub
Public Function RowsMatch(rowNumber As Long) As Boolean

Dim thisCol As Long

RowsMatch = True
For thisCol = 1 To 15
    If Not (thisCol = 2 Or thisCol = 5 Or thisCol = 6) Then
        RowsMatch = RowsMatch And (Cells(rowNumber, thisCol).Value = Cells(rowNumber + 1, thisCol).Value)
        If Not RowsMatch Then Exit For
    End If
Next thisCol

End Function

WBD

 

[MickG]

Another option:-
NB:- This code will delete the extra rows.

[COLOR=navy]Sub[/COLOR] MG06Dec26
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, nRng [COLOR=navy]As[/COLOR] Range, txt [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
Application.ScreenUpdating = False
[COLOR=navy]
Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]
For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
txt = Dn.Value & Dn.Offset(, 2).Value & Dn.Offset(, 3).Value
    [COLOR=navy]If[/COLOR] Not .Exists(txt) [COLOR=navy]Then[/COLOR]
        .Add txt, Dn.Offset(, 4)
    [COLOR=navy]Else[/COLOR]
      .Item(txt).Value = .Item(txt).Value + Dn.Offset(, 4).Value
      .Item(txt).Offset(, 1).Value = .Item(txt).Offset(, 1).Value + Dn.Offset(, 5).Value
       [COLOR=navy]If[/COLOR] nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] [COLOR=navy]Set[/COLOR] nRng = Dn Else [COLOR=navy]Set[/COLOR] nRng = Union(nRng, Dn)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]

     [COLOR=navy]If[/COLOR] Not nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] nRng.EntireRow.Delete
[COLOR=navy]End[/COLOR] With

Application.ScreenUpdating = True
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[wideboydixon]

Hi @MickG,

I read the OP requirements as wanting to compare columns A, C:D, G:O. Perhaps I'm mistaken.

WBD

 

[MickG]

Hi WBD,
You may well be right, but as columns "G to O" were not included I just took headers:- "Product", Buyer" & "Date"
Hopefully one off use will be right !!!

Mick

 

[bukimi]

Thank you for your solutions. Your solution, MickG, is too complicated for me, way over my level of VBA skills.
I can't read what is what, that is: where number of this "useless" column is, where are numbers of columns with values for adding and where is number of columns in a database
I checked my actual database and it has 15 columns, "useless" column is column "I" (9th) and values for adding are in columns K and L (11 and 12). I don't know how to alter your code for it (I may use given code without understanding it, but you'd have to change it for me, unfortunately).

WBD, your code is more clear to me. I just want to make sure:

 If Not (thisCol = 2 Or thisCol = 5 Or thisCol = 6) Then

It contains numer of useless column (2) and two columns with values (5 and 6)?

and this one

Cells(thisRow, 5).Value = Cells(thisRow, 5).Value + Cells(thisRow + 1, 5).Value
Cells(thisRow, 6).Value = Cells(thisRow, 6).Value + Cells(thisRow + 1, 6).Value

refers to columns 5 and 6 as columns with values to add?

If yes, then I can modify it myself accordingly.

Database has 116.000 rows now, so compressing it will be a huge relief.

 

[wideboydixon]

Hi @bukimi,

Yes you're right; I'm ignoring columns B, E and F for the comparison. If the rows match then we accumulate columns E and F (5 and 6).

WBD

 

[MickG]

No problem, I'm sure WBD will provide you with what you want.
Regrds Mick

 

[bukimi]

Hi @bukimi,

Yes you're right; I'm ignoring columns B, E and F for the comparison. If the rows match then we accumulate columns E and F (5 and 6).

WBD

It worked. It took almost 30 minutes to compile (even after disabling ScreenUpdating), but file is 5MB instead of 13MB and has 35k rows instead of 116k. Big relief!
Thank you very much!