totn Excel

MS Excel 2003: Test for duplicates in two columns, combined

This Excel tutorial explains how to write a macro to test for duplicates in two columns 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 which would highlight any duplicate values where both columns A and B in two or more lines are the same?

Answer: Let's look at an example.

Download Excel spreadsheet (as demonstrated below)

Microsoft Excel

In our spreadsheet, we've set up values in both columns A and B. On this sheet, we've created a button that when clicked will launch a macro. This macro will highlight any duplicate values where both columns A and B in two or more lines are the same.

In our example, we've clicked on the button. Now the background color of the duplicates will turn red as follows:

Microsoft Excel

In this example, the same values have been entered in rows 2 and 6.

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

Please note that the LRows variable in this macro is set to 200 indicating that the macro will test the first 200 rows in columns A and B 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 LClearRange As String
   Dim Lrows As Integer
   Dim LRange As String

   'Column A values
   Dim LChangedValue As String
   Dim LTestValue As String

   'Column B values
   Dim LChangedValueB As String
   Dim LTestValueB As String

   'Test first 200 rows in spreadsheet for uniqueness
   Lrows = 200
   LLoop = 2

   'Clear all flags
   LClearRange = "A2:B" & Lrows
   Range(LClearRange).Interior.ColorIndex = xlNone

   'Check first 200 rows in spreadsheet
   While LLoop <= Lrows
      LChangedValue = "A" & CStr(LLoop)
      LChangedValueB = "B" & CStr(LLoop)
      If Len(Range(LChangedValue).Value) > 0 Then

         'Test each value for uniqueness
         LTestLoop = 2
         While LTestLoop <= Lrows
            If LLoop <> LTestLoop Then
               LTestValue = "A" & CStr(LTestLoop)
               LTestValueB = "B" & CStr(LTestLoop)
               'Value has been duplicated in another cell
               If (Range(LChangedValue).Value = Range(LTestValue).Value) And (Range(LChangedValueB).Value = Range(LTestValueB).Value) Then
                  'Set the background color to red in column A
                  Range(LChangedValue).Interior.ColorIndex = 3
                  Range(LTestValue).Interior.ColorIndex = 3

                  'Set the background color to red in column B
                  Range(LChangedValueB).Interior.ColorIndex = 3
                  Range(LTestValueB).Interior.ColorIndex = 3

               End If

            End If

            LTestLoop = LTestLoop + 1
         Wend

      End If

      LLoop = LLoop + 1

   Wend

End Sub