Excel|2007|2003|Microsoft Excel|Formula|Function|Pivto Table|Excel Topics|Passwords|Hyperlink Excel Guru: Test for duplicates in two columns, combined in Excel 2003/XP/2000/97

Friday, October 2, 2009

Test for duplicates in two columns, combined in Excel 2003/XP/2000/97

Question: In 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 take a look at an example.
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:

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

0 comments:

Post a Comment