---

MS Excel 2003: Test for duplicates in eight columns, combined (and delete duplicates)

This Excel tutorial explains how to write a macro to test for duplicates in eight columns combined and delete duplicates in Excel 2003 and older versions (with screenshots and step-by-step instructions).

Question: In Microsoft Excel 2003/XP/2000/97, is it possible to write a macro to check 8 columns over 2000 rows and delete the duplicates?

Answer: Let's look at an example.

Download Excel spreadsheet (as demonstrated below)

In our spreadsheet, we've set up values in columns A through H. On Sheet1, we've created a button that when clicked will launch a macro. This macro will delete any duplicate values (based on the values in columns A through H).

When the macro has completed, a message box will appear that indicates how many duplicate rows were deleted.

After the macro has run, you can see that two rows have been deleted.

You can press Alt+F11 to view the VBA code.

Please note that the LRows variable in this macro is set to 2000 indicating that the macro will test the first 2000 rows in for duplicates. You may need to change this value to accommodate your volume of data.

Macro Code

The macro code looks like this:

Sub TestForDups()

   Dim LLoop As Integer
   Dim LTestLoop As Integer
   Dim Lrows As Integer
   Dim LRange As String
   Dim LCnt As Integer

   'Column values
   Dim LColA_1 As String
   Dim LColB_1 As String
   Dim LColC_1 As String
   Dim LColD_1 As String
   Dim LColE_1 As String
   Dim LColF_1 As String
   Dim LColG_1 As String
   Dim LColH_1 As String
   Dim LColA_2 As String
   Dim LColB_2 As String
   Dim LColC_2 As String
   Dim LColD_2 As String
   Dim LColE_2 As String
   Dim LColF_2 As String
   Dim LColG_2 As String
   Dim LColH_2 As String

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

   'Check first 2000 rows in spreadsheet
   While LLoop <= Lrows
      LColA_1 = "A" & CStr(LLoop)
      LColB_1 = "B" & CStr(LLoop)
      LColC_1 = "C" & CStr(LLoop)
      LColD_1 = "D" & CStr(LLoop)
      LColE_1 = "E" & CStr(LLoop)
      LColF_1 = "F" & CStr(LLoop)
      LColG_1 = "G" & CStr(LLoop)
      LColH_1 = "H" & CStr(LLoop)

      If Len(Range(LColA_1).Value) > 0 Then

         'Test each value for uniqueness
         LTestLoop = LLoop + 1
         While LTestLoop <= Lrows
            If LLoop <> LTestLoop Then
               LColA_2 = "A" & CStr(LTestLoop)
               LColB_2 = "B" & CStr(LTestLoop)
               LColC_2 = "C" & CStr(LTestLoop)
               LColD_2 = "D" & CStr(LTestLoop)
               LColE_2 = "E" & CStr(LTestLoop)
               LColF_2 = "F" & CStr(LTestLoop)
               LColG_2 = "G" & CStr(LTestLoop)
               LColH_2 = "H" & CStr(LTestLoop)

               'Value has been duplicated in another cell (based on values in columns A to H)
               If (Range(LColA_1).Value = Range(LColA_2).Value) _
                And (Range(LColB_1).Value = Range(LColB_2).Value) _
                And (Range(LColC_1).Value = Range(LColC_2).Value) _
                And (Range(LColD_1).Value = Range(LColD_2).Value) _
                And (Range(LColE_1).Value = Range(LColE_2).Value) _
                And (Range(LColF_1).Value = Range(LColF_2).Value) _
                And (Range(LColG_1).Value = Range(LColG_2).Value) _
                And (Range(LColH_1).Value = Range(LColH_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("A1").Select
   MsgBox CStr(LCnt) & " rows have been deleted."

End Sub