Help finding duplicate info in Excel in different columns

20 pts.
Duplicate records
Microsoft Excel
microsoft excel functions
Microsoft Excel macros
Hi, I have an excel spreadsheet that looks like below: Origin Store1 Store2 Percent Source Warren 12345 45678 2.45 b Warren 45678 12345 2.45 r I want to be able to recognize and delete one of these rows as a duplicate. The info is the same just in a different column whether it be Store1 or Store2, and the source doesn't really matter. When it comes down to r or b I will keep r. I have over 32000 rows with probably 25% of them duplicates like above and am looking for an easy way to identify and delete them. Any ideas would be much appreciated

Answer Wiki

Thanks. We'll let you know when a new response is added.

I think I have a solution for your problem.
Take a <b>copy your file for safety</b>.
In the copied file You have to write macros to solve the problem.
Just <b>copy & paste the code below in a module</b>.
Then <b>first, run the macro “FindDuplicate”</b>, to mark duplicate rows.
Then check if everything is ok, <b>then run second macro “DeleteDuplicateRows”</b>, to delete the duplicate rows.

To write macro in Excel, “Tools” menu —> “Macro” , “Visual Basic Editor”
In Visual Basic Editor, “Insert” menu —> “Module”
In Module copy & paste the following code.

Then to run the macro in Excel, “Tools” menu —> “Macro”, “Macros…”
Then select the macro name, click on “Run”

Please tell me weather it helps or not.
Mayuri Shah

‘=========================== CODE START ===========================
Dim LastRow As Integer ‘last row number of data
Public Sub FindDuplicate()
‘Select entire data for sorting
LastRow = ActiveCell.SpecialCells(xlLastCell).Row
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

‘Sort selected data in this order – 1. origin asc, 2. percent desc, 3. source desc (desc because u want to keep ‘r’)
Selection.Sort Key1:=Range(“A2”), Order1:=xlAscending, Key2:=Range(“D2”) _
, Order2:=xlAscending, Key3:=Range(“E2”), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
Call FindInGroup
End Sub
Private Sub FindInGroup()
‘Here first I have grouped and selected the rows where origin and percent are same, means within these rows we have to find duplicates of each other
Dim RowNum, RngRowStrt As Integer
Dim AColText, DColText As String

RngRowStrt = 2
AColText = Range(“A” & RngRowStrt).Text
DColText = Range(“D” & RngRowStrt).Text
RowNum = RngRowStrt + 1
If Range(“A” & RowNum).Text <> AColText Or Range(“D” & RowNum).Text <> DColText Then
Exit Do
End If
RowNum = RowNum + 1
If RowNum > LastRow Then Exit Do
Range(“A” & RngRowStrt, “E” & RowNum – 1).Select ‘selects the group data
Call BorderData
‘Within selected group data searches for duplicates
‘These two loops compares each row in selection with each and every row in selection
For i = RngRowStrt To RowNum – 2
For j = i + 1 To RowNum – 1
If (Range(“B” & i) = Range(“B” & j) And Range(“C” & i) = Range(“C” & j)) Or (Range(“B” & i) = Range(“C” & j) And Range(“C” & i) = Range(“B” & j)) Then
Range(“G” & j) = “Duplicate”
End If
If RowNum > LastRow Then Exit Do
RngRowStrt = RowNum
MsgBox “All the duplicate rows are marked as ‘ Duplicate ‘, in column ‘ G ‘.” & VBA.Chr(13) & “Please check it once. If you find it proper then please run the macro ‘ DeleteDuplicateRows ‘ to delete all duplicate rows permanently.”
End Sub
Private Sub BorderData()
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
End Sub
Public Sub DeleteDuplicateRows()
For i = LastRow To 2 Step -1
If Range(“G” & i).Text = “Duplicate” Then
Selection.Delete Shift:=xlUp
End If
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

‘=========================== CODE END ===========================

Discuss This Question:  

There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

Thanks! We'll email you when relevant content is added and updated.


Share this item with your network: