Delete duplicates based on two collumns

Hi,

I have a big spreadsheet containing costumers purshases for a period. The same customer generally purshased the same product more than once. I need to eliminate all the duplicate lines based with the same value on 2 collumns, the customer (B) and the product (D) in order to keep only one line for each product that the customers purshased.

Thanks for helping...

Simon

Here are two methods. First one uses a formula in Col K, paste and drag down. Then in conjunction with the first macro listed
below, will remove dupes.

The second method (second macro) only requires a command button on Sheet Feuil2 and no formulas.

Option Explicit

''###### MACRO ONE BEGINS #####
'Delete dupes by formula & this macro
'First, paste this formula into K2, then drag down : =B2&D2
'Next paste a command button on sheet Feuil2 and attach to this macro :

Sub text()
Dim j As Integer, k As Integer, r As Range
j = Range("K2").End(xlDown).Row
    For k = j To 2 Step -1
    'MsgBox k
    Set r = Range(Cells(k, "K"), Cells(k, "K").End(xlUp))
        If WorksheetFunction.CountIf(r, Cells(k, "K")) > 1 Then
            Cells(k, "K").EntireRow.Delete
        End If
    Next k
End Sub

''##### MACRO ONE ENDS #####


''##### MACRO TWO BEGINS #####
'You can forego all of the above by pasting a command button on sheet Feuil2 attached
'this macro:

Sub TestForDups()

   Dim LLoop As Integer
   Dim LTestLoop As Integer
   Dim Lrows As Integer
   Dim LRange As String
   Dim LCnt As Integer
On Error Resume Next
Application.ScreenUpdating = False
   'Column values
      
   Dim LColB_1, LColD_1
   Dim LColB_2, LColD_2

   'Test first 400 rows in spreadsheet for duplicates (delete any duplicates found)
   Lrows = 40
   LLoop = 2
   LCnt = 0

   'Check first 40 rows in spreadsheet
   While LLoop <= Lrows
     
      LColB_1 = "B" & CStr(LLoop)
      LColD_1 = "D" & CStr(LLoop)
     
      If Len(Range(LColB_1).Value) > 0 Then

         'Test each value for uniqueness
         LTestLoop = LLoop + 1
         While LTestLoop <= Lrows
            If LLoop <> LTestLoop Then
               LColB_2 = "B" & CStr(LTestLoop)
               LColD_2 = "D" & CStr(LTestLoop)
               
              'Value has been duplicated in another cell (based on values in columns A to H)
               If (Range(LColB_1).Value = Range(LColB_2).Value) _
               And (Range(LColD_1).Value = Range(LColD_2).Value) Then
                
                  'Delete the duplicate
                  Rows(CStr(LTestLoop) & ":" & CStr(LTestLoop)).Select
                  Selection.Delete Shift:=xlUp

                  'Decrement counter since row was deleted
                  LTestLoop = LTestLoop - 1

                  LCnt = LCnt + 1

               End If

            End If

            LTestLoop = LTestLoop + 1
         Wend

      End If

      LLoop = LLoop + 1
   Wend

   'Reposition back on cell A1
   Range("L2").Select
   
Application.ScreenUpdating = True
End Sub

''##### MACRO TWO ENDS #####

You will be able to view the dupes deletion as the yellow highlighted row will be deleted leaving the beige colored row.

Fantastik! Thanks so much... the idea of merging the cust num. + the product code and delete duplicates was so logic, I probably stayed to late at the office.... I'll keep this trick in mind!

Thanks,

Simon