Comparing rows without comparing each cell separately

bukimi

Board Regular
Joined
Apr 12, 2017
Messages
105
Office Version
  1. 2019
Platform
  1. Windows
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...
Code:
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.
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
You could use a helper function something like this:

Code:
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
 
Upvote 0
Another option:-
NB:- This code will delete the extra rows.
Code:
[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
 
Last edited:
Upvote 0
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
 
Upvote 0
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 :sad:
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:
Rich (BB code):
 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
Rich (BB code):
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.
 
Last edited:
Upvote 0
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
 
Upvote 0
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!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,331
Members
452,636
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top