lundi 20 avril 2015

Macro to check for duplicates in a column

Ive looked through the site and found a couple of example of code that looks for duplicates but they only match on partial case and not exact match.

I have a macro which takes a cell value and then looks in the column for any duplicates and increment a count for any it finds. However, it kind of works as it finds partial match duplicates but i need it to only match exact match duplicates.

For example currently if i have a row that contains a 1 and another row that contains an 11 it will highlight them rows as duplicated.

Here is the code i currently have.

Function CountMatches(searchvalue As String, sheet As Worksheet, r As String) As Integer

Dim firstFound As Range
Dim lastFound As Range
Dim matchCount As Integer
Set firstFound = sheet.Range(r).Find(searchvalue, After:=ActiveCell, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=True)

sheet.Range(r).Select

Set firstFound = sheet.Range(r).Find(What:=searchvalue, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

If firstFound Is Nothing Then

  CountMatches = 0


Else

Do

        Set lastFound = sheet.Range(r).Find(What:=searchvalue, After:=IIf(lastFound Is Nothing, firstFound, lastFound), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False)

      matchCount = matchCount + 1

   Loop Until lastFound Is Nothing Or firstFound.Address = lastFound.Address

  CountMatches = matchCount


  End If

End Function

Aucun commentaire:

Enregistrer un commentaire