Merge duplicates and sum columns

Question

I need some code to find duplicates in Column B, then if found sum Columns I, J & L. Then delete the duplicate rows, only leaving the 1 instance.

I have a button click on Sheet1, and the code needs to run on Sheet4.

I currently have this code, which does the task perfectly, but it only works on the active sheet, i cannot seem to make it work for a different sheet.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False      '### Excel wont update its screen while executing this macro. This is a huge performace boost
Dim SumCols() '### declare a second empty array for our sum columns
SumCols() = Array(9, 10, 12)         '### the second array stores the columns which should be summed up
'### the next line sets our range for searching dublicates. Starting at cell A2 and ending at the last used cell in column A
Set searchrange = Range([b1], Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))
For Each cell In searchrange            '### now we start looping through each cell of our searchrange
    Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole)   '### searches for a dublicate. If no dub exists, it finds only itself
    Do While Search.Address <> cell.Address     '### until we find our starting cell again, these rows are all dublicates

        For i = 0 To UBound(SumCols)    '### loop through all columns for calculating the sum
            '### next line sums up the cell in our starting row and its counterpart in its dublicate row
            Cells(cell.Row, SumCols(i)) = CDbl(Cells(cell.Row, SumCols(i))) + CDbl(Cells(Search.Row, SumCols(i)))
        Next i                          '### go ahead to the next column

        Search.EntireRow.Delete         '### we are finished with this row. Delete the whole row
        Set Search = searchrange.Find(cell, after:=cell)    '### and search the next dublicate after our starting row
    Loop

Next                                    '### from here we start over with the next cell of our searchrange

                                        '### Note: This is a NEW unique value since we already deleted all old dublicates

Application.ScreenUpdating = True '### re-enable our screen updating
End Sub

All help is appreciated!!!!

eirikdaude · Answer 1 · 2015-06-02T12:47:14.677

1

Assuming you want to perform the operation on every worksheet in your workbook, you just have to wrap another for each-loop around the rest of your code, and then specify that it is in that worksheet your range is. For the code you're posting, it'd look something like this:

Option Explicit

Private Sub CommandButton1_Click()
  Application.ScreenUpdating = False
  Dim SumCols()
  Dim ws As Worksheet
  SumCols() = Array(9, 10, 12)

  For Each ws In Worksheets
    Set searchrange = Range(ws.Range("B1"), ws.Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))
    For Each cell In searchrange
      Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole)
      Do While Search.Address <> cell.Address
        For i = 0 To UBound(SumCols)
            '### next line sums up the cell in our starting row and its counterpart in its dublicate row
            Cells(cell.Row, SumCols(i)) = CDbl(Cells(cell.Row, SumCols(i))) + CDbl(Cells(Search.Row, SumCols(i)))
        Next i
        Search.EntireRow.Delete
        Set Search = searchrange.Find(cell, after:=cell)
      Loop
    Next cell
  Next ws
  Application.ScreenUpdating = True
End Sub

The relevant changes are the extra for each-loop, and changing

 Set searchrange = Range([b1], Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))

to

 Set searchrange = Range(ws.Range("B1"), ws.Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))

edited Jun 02 '15 at 12:47

answered Jun 02 '15 at 12:17

eirikdaude

3,106
6
25
50

Hi thanks for the response. I only need to to perform the operation on the sheet MergedData. thanks – atame Jun 02 '15 at 12:20
@atame In that case you won't have to loop through all the sheets, just you just specify the worksheet prior to the range instead: `Set searchrange = Worksheets("MergedData").Range(...)`. Alternately you can refer to it by its [codename](https://msdn.microsoft.com/en-us/library/office/ff837552.aspx), to make it harder for your users to screw up anything. – eirikdaude Jun 02 '15 at 12:36
I have tried that and it give me a Run-time error '9': subscript out of range?? Thanks – atame Jun 02 '15 at 12:40
It seems I didn't read your code closely enough (it is quite hard to read, you may want to think about cleaning it up a little)... Anyway, you need to put the worksheet specification in front of every range-object you give an address to, but not in front of the range-function. In other words that line should look something like this: `Set searchrange = Range(Worksheet("Name").Range("B1"), Worksheets("Name").Columns(2).Find(what:="*", after:=[b1], searchdirection:=xlPrevious))` @atame – eirikdaude Jun 02 '15 at 12:45
thanks for the help, but tonester640 has provide a working answer. thanks – atame Jun 02 '15 at 12:58
@atame His solution is really bad practice - see the question I linked and the related answers / linked articles. – eirikdaude Jun 02 '15 at 13:04

score 0 · Accepted Answer · answered Jun 02 '15 at 12:53

0

Either select the sheet first, so it becomes the ActiveSheet:

Sheets("MergedData").Select

Or preferably reference using With (not tested):

Option Explicit

Private Sub CommandButton1_Click()
    Dim searchrange As Range, cell As Range, Search As Range
    Dim I As Integer
    Dim SumCols()
    Application.ScreenUpdating = False
    SumCols() = Array(9, 10, 12)

    With Sheets("MergedData")
        Set searchrange = .Range(.Range("b1"), .Columns(2).Find(what:="*", after:=.Range("b1"), searchdirection:=xlPrevious))

        For Each cell In searchrange
            Set Search = searchrange.Find(cell, after:=cell, lookat:=xlWhole)

            Do While Search.Address <> cell.Address
                For I = 0 To UBound(SumCols)
                    .Cells(cell.Row, SumCols(I)) = CDbl(.Cells(cell.Row, SumCols(I))) + CDbl(.Cells(Search.Row, SumCols(I)))
                Next I

                Search.EntireRow.Delete
                Set Search = searchrange.Find(cell, after:=cell)
            Loop
        Next
    End With

    Application.ScreenUpdating = True
End Sub

answered Jun 02 '15 at 12:53

tonester640

94
9

Using `select` to specify ranges or worksheets in your code is really bad practice... http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros – eirikdaude Jun 02 '15 at 13:03
1

It is, which is why I said preferably reference using With Sheets("MergedData"). – tonester640 Jun 02 '15 at 13:06
Hi guys, i have tried boths ways, and the only code that works is the `With Sheets("MergedData")` i get errors if i do it any other way? – atame Jun 02 '15 at 13:19
So just use the one that works, using Select should be avoided where possible. – tonester640 Jun 02 '15 at 14:34
@tonester640 yeah that what i have done. Thanks again for all the help!!! Much appreciated!!!!. – atame Jun 02 '15 at 15:54
@tonester640 Ah, sorry, seems I skimmed it a bit to quickly. Downvote removed. – eirikdaude Jun 02 '15 at 17:41

Merge duplicates and sum columns

2 Answers2