MS Excel 2003: Test for duplicates in eight columns, combined (and clear the values in the 8 columns when a duplicate is found)
This Excel tutorial explains how to write a macro to test for duplicates in eight columns combined and clear the values when a duplicate is found 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 clear the values in the 8 columns when a duplicate is found?
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 I. On Sheet1, we've created a button that when clicked will launch a macro. This macro will clear the values in columns A through H when a duplicate is found (based on the values in columns A through H). It does not clear the value in column I when a duplicate is found.
When the macro has completed, a message box will appear that indicates how many duplicates were cleared..
After the macro has run, you can see that cells A through H of the duplicate have been cleared, as seen below in rows 9 and 16.
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 (clear 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 'Clear the duplicate Range("A" & CStr(LTestLoop) & ":H" & CStr(LTestLoop)).Select Selection.ClearContents 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 cleared." End Sub
Advertisements