How-To Geek Forums / Microsoft Office
(Solved) - Find duplicate cells in Excel
(23 posts)- Remove Solved Status
Hi 6card
If your column containing duplicate values is sorted so that the duplicates are contiguous you can try this solution found by Enthusiast. If they aren't sorted or cannot be sorted let us know and we can see if we can build a macro solution.
Just because it's a slow Monday (Public Holiday here) here is a quick Macro to replace duplicates with XXXXX. It prompts for a column number.
Sub DelDup()
Dim lNum As Integer
On Error Resume Next
Application.DisplayAlerts = False
lNum = Application.InputBox _
(Prompt:="Please enter the Column you want to Dedupe e.g Column A = 1, B = 2 etc.", _
Title:="Column to Dedupe", Type:=1)
On Error GoTo 0
Application.DisplayAlerts = True
' Find the number of rows populated
LastRow = Cells(1, lNum).End(xlDown).Address
NoRows = Range(Cells(1, lNum).Address, LastRow).Count
For c = 1 To NoRows
For i = 1 To NoRows
If i = c Then GoTo 111
If Cells(i, lNum) = "XXXXX" Then GoTo 111
If Cells(i, lNum) = Cells(c, lNum) Then
Cells(i, lNum) = "XXXXX"
End If
111 Next i
Next c
End Sub
moreeg,
I have modified your macro slightly to allow the user to click on a cell in the column to remove duplicates from. It occured to me that they user, if working in column "GF1", would not have a clue what the column number is to input it. I also modified your loop structure to remove the GOTO, preferring to use nested IF structures for readability. See what you think.
Sub DelDup()
Dim lNum As Integer
Dim rngInput As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rngInput = Application.InputBox(Prompt:= _
"Please click in the column to remove duplicates.", _
Title:="SPECIFY COLUMN", Type:=8)
lNum = rngInput.Column
On Error GoTo 0
Application.DisplayAlerts = True
' Find the number of rows populated
LastRow = Cells(1, lNum).End(xlDown).Address
NoRows = Range(Cells(1, lNum).Address, LastRow).Count
For c = 1 To NoRows
For i = 1 To NoRows
If i <> c Then
If Cells(i, lNum) <> "XXXXX" Then
If Cells(i, lNum) = Cells(c, lNum) Then
Cells(i, lNum) = "XXXXX"
End If
End If
End If
Next i
Next c
End SubHi Enthusiast
"if working in column "GF1"," ... that's why we got fingers and toes :) but I take your point - being able to click is much easier.
Your nested ifs are absolutely much more elegant (add bold. 16" Font, bright red for emphasis) and almost assuredly more efficient than my code but "easier to read"???. I suppose for programmers that is true but not, unfortunately, for me which is why I ended up with a bunch of random if statement. So thanks for that - hopefully I'll be able to produce code similar to yours next time.
In the end though, this macro is very dangerous stuff because it overwrites your data. If anything should go wrong the potential of losing data is very high. I would opt for the conditional formatting solution or if a macro is absolutely necessary then creating an empty adjacent column to mark a duplicate.
But most amazing of all that I'd like to know is ..... how did you preserve the indent in the post????
try this ...
Sub DelDup()
Dim lNum As Integer
Dim rngInput As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rngInput = Application.InputBox(Prompt:= _
"Please click in the column to remove duplicates.", _
Title:="SPECIFY COLUMN", Type:=8)
lNum = rngInput.Column
On Error GoTo 0
Application.DisplayAlerts = True
' Find the number of rows populated
LastRow = Cells(1, lNum).End(xlDown).Address
NoRows = Range(Cells(1, lNum).Address, LastRow).Count
For c = 1 To NoRows
For i = 1 To NoRows
If i <> c Then
If Cells(i, lNum) <> "XXXXX" Then
If Cells(i, lNum) = Cells(c, lNum) Then
Cells(i, lNum) = "XXXXX_" & Cells(i, lNum)
End If
End If
End If
Next i
Next c
End Sub
moreeg,
I think I will start my responses with a disclaimer, "Always test others suggestions on a COPY of your spreadsheet. Keep your original safe."
As for the way to keep from having to use GOTO, consider this code:
.
.
if numRow = 13 Then GOTO 1111
TotalSpent = TotalSpent + value(numRow)
1111 End If
.
.In that code you are testing for a condition in which you DON'T want to add to the TotalSpent. However, if you invert that test to be a test for only what you DO want to add to TotalSpent, we can clean up the code, as in:
.
.
if numRow <> 13 Then
TotalSpent = TotalSpent + value(numRow)
End If
.
.We accomplish the same goal, however, by inverting any test that would result in requiring a GOTO, we can keep the code cleaner and more readable.
@all,
That took me a long time to figure out. You bracket your code with "< code >" and "</ code >" (no quotes or spaces inside the quotes). That much we know. The important thing to do is after you "Send Post", you turn around and edit your post. Then simply "Send Post" again. I figured this out by attempting to fix a typo right after I submitted a post. After the Edit, I sent the post again and noticed the indents were where they should be.
Weird workaround, but as you see, it works. Have at it guys!
Here is the non-destructive version, which simply highlights the duplicates:
Sub DelDup()
Dim lNum As Integer
Dim rngInput As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rngInput = Application.InputBox(Prompt:= _
"Please click in the column to remove duplicates.", _
Title:="SPECIFY COLUMN", Type:=8)
lNum = rngInput.Column
On Error GoTo 0
Application.DisplayAlerts = True
' Find the number of rows populated
LastRow = Cells(1, lNum).End(xlDown).Address
NoRows = Range(Cells(1, lNum).Address, LastRow).Count
For c = 1 To NoRows
For i = 1 To NoRows
If i <> c Then
If Cells(i, lNum) <> "XXXXX" Then
If Cells(i, lNum) = Cells(c, lNum) Then
Cells(i, lNum).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
End If
Next i
Next c
End Sub@Enthusiast -
thanks for the tips. I'll refrain from making any philosophical connections
about my "negative" approach to code
versus your "positive" one but I must admit that the positive
approach is intuitively cleaner and
easier to understand.
@6card
If you want to delete the duplicates the easiest way
is to use the "Remove Duplicates" in the Data Ribbon.
It's dead simple to use and has the advantage of allowing
you to "undo" in case the results are not
as expected.
@Enthusiast
Yep ----- <Code > works a treat
what other HTML tags can we use? (I've been trying < b >< /b> but with no success)@moreeg,
That is the only one I have found that works so far. I believe I originally tried it because it is a BB code.
"[ u ]" and "[ /u ]" work to underline
"[ quote ]" and "[ /quote ]" allow you to do quotations or notes.
I seem to remember an issue where posters were putting large fonts and different colors on their posts and the mods asked them to stop. The codes may have been inactivated at that time.
@Enthusiast
Your highlighting code works slightly differently from the original in that the original will only mark the true duplicates and leave the first occurrence unmarked. Either way it would be the user's preference how they want it but here is the code that will highlight only the duplicates and not the original ...
Sub DelDup2()
Dim lNum As Integer
Dim rngInput As Range
On Error Resume Next
Application.DisplayAlerts = False
Set rngInput = Application.InputBox(Prompt:= _
"Please click in the column to remove duplicates.", _
Title:="SPECIFY COLUMN", Type:=8)
lNum = rngInput.Column
On Error GoTo 0
Application.DisplayAlerts = True
' Find the number of rows populated
LastRow = Cells(1, lNum).End(xlDown).Address
NoRows = Range(Cells(1, lNum).Address, LastRow).Count
For c = 1 To NoRows
For i = 1 To NoRows
If i <> c Then
If Cells(c, lNum).Interior.Color <> 65535 Then
If Cells(i, lNum) = Cells(c, lNum) Then
Cells(i, lNum).Interior.Color = 65535
End If
End If
End If
Next i
Next c
End SubTopic Closed
This topic has been closed to new replies. Please create a new topic instead.
