Find duplicates with VBA

[Hansen]

Hello all,

I want to use a VBA macro in excel to find duplicates within a column. I want to write "Duplicate" into the row of the duplicate value, but only for the 2nd or 3rd time it appears. Here is an example:



Value



1



2



1
Duplicate


3



3
Duplicate


1
Duplicate



As you can see the first time a duplicate appears the 2nd column is empty. Only the 2nd and 3rd time the value appears, it says duplicate in the second column.

I tried doing this using the following code (I was actually trying to look for duplicates in column B):


Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
lastRow = Range("A65000").End(xlUp).Row
For iCntr = 1 To lastRow
If Cells(iCntr, 2) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 3) = "Duplicate"
End If
End If
Next



Dim lastRow As Integer
Dim rownumber As Integer
Dim myrange As Range


lastRow = Worksheets("Data").Cells(Worksheets("Data").Rows.Count, 1).End(xlUp).Row
rownumber = 2
Set myrange = Range("B:B")


Do While Worksheets("Data").Cells(rownumber, "A").Value <> ""
If Application.WorksheetFunction.CountIf(myrange, Worksheets("Data").Cells(rownumber, "B").Value) > 0 Then
Worksheets("Data").Cells(rownumber, "AG").Value = "Duplicate"
Else
End If


rownumber = rownumber + 1
Loop


Both the subs seem to run, but no result is showing.

As I am quite new to VBA any advice would be greatly appreciated!
Thanks!

[snb]

Not for newbies:


Sub M_snb()
[B1:B200] = [if(A1:A200="","",if(countif(offset(A$1,,,row($1:200)),A$1:A$200)>1,"dup",""))]
End Sub

[GTO]

Greetings Hansen,

In a Standard Module:



Option Explicit

Sub example()
Dim rngLastCell As Range
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long

With Sheet1 '<--using CodeName, or worksheet name --> ThisWorkbook.Worksheets ("Name on Tab")
'Find last row with data. I used column B since that is where you are looking for duplicates.
Set rngLastCell = RangeFound(.Range("B:B"))

If Not rngLastCell Is Nothing Then
lastRow = rngLastCell.Row
For iCntr = 1 To lastRow
If Not .Cells(iCntr, "B").Value = vbNullString Then

'From your code, this will find a match no matter what, so no error handling needed.
matchFoundIndex = Application.Match(.Cells(iCntr, "B").Value, .Range("B1:B" & lastRow), 0)
If Not iCntr = matchFoundIndex Then
.Cells(iCntr, "C").Value = "Duplicate"
End If
'Added to find the first value in duplicated values
If Not iCntr = lastRow Then
'reset
matchFoundIndex = 0
'Ignore possible error just for .Match, change range being looked IN to the cells AFTER the the cuurent cell being looked AT.
On Error Resume Next
matchFoundIndex = Application.Match(.Cells(iCntr, "B").Value, .Range(.Cells(iCntr + 1, "B"), .Cells(lastRow, "B")).Value, 0)
On Error GoTo 0
'If we find a duplicate value farther down the range...
If Not matchFoundIndex = 0 Then
.Cells(iCntr, "C").Value = "First Duplicate"
End If
End If
End If
Next
End If
End With
End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange.Cells(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function


Hope that helps,

Mark