Home » excel » excel vba – VBA count and print every cell address when a duplicate value is found

excel vba – VBA count and print every cell address when a duplicate value is found

Posted by: admin May 14, 2020 Leave a comment

Questions:

I am trying to count the number of cells where a duplicate value is found
and then print them in a message box.
At the moment my code successfully finds the values but only print the cell with the second duplicate value and not all the cells with the same value . It must be something like this:

The id “wrong id” is used multiple times (“ids”) .
*ids of all cells, separated with comma. In this example “A6, A7” .Here is my code:

Sub sbFindDuplicatesInColumn()

Dim cell As Range
Dim mess As String
Dim rngcheck As Range
Dim rng1 As Range
Dim C As Range
Dim objDic
Dim strMsg As String

Set objDic = CreateObject("scripting.dictionary")
Set rng1 = Range([a1], Cells(Rows.count, "A").End(xlUp))
For Each C In rng1

    If Len(C.Value) > 0 Then
        If Not objDic.exists(C.Value) Then
            objDic.Add C.Value, 1
        Else
            strMsg = strMsg & "The id" & C.Value & " is used multiple times " & C.Address(0, 0) & vbNewLine
        End If
    End If
Next
    If Len(strMsg) > 0 Then MsgBox strMsg
End Sub
How to&Answers:

So, say your list is

1
2
3
1
5
2

Your expected output is:

The id '1' is used multiple times: A1, A4
The id '2' is used multiple times: A2, A6

But your actual output is

The id '1' is used multiple times: A4
The id '2' is used multiple times: A6

This is because you don’t store the first encounter of the index value, only that you encounter it.

Try something like this:

For Each C In rng1   
    If Len(C.Value) > 0 Then
        If Not objDic.exists(C.Value) Then
            objDic.Add C.Value, CStr(C.Address)
        Else
            objDic(C.Value) = objDic(C.Value) & ", " & CStr(C.Address)
        End If
    End If
Next

Dim comma As String, strMsg As String
strMsg = ""
For Each i In objDic.Keys
    pcs = Split(objDic(i), ",")
    If Ubound(pcs) > 1 Then
        strMsg = strMsg & "The id" & i & " is used multiple times "
        comma = ""
        For Each p In pcs
            strMsg = strMsg & comma & p
            comma = ", "
        Next
        strMsg = strMsg & vbNewLine
    End If
Next
If Len(strMsg) > 0 Then MsgBox strMsg

Answer:

You could do something like this, calling SetUpDictionary first, then using the CheckDupe function to check

Private dDupeChecker As Scripting.Dictionary

Function CheckDupe(rCheck As Excel.Range) As String
    If dDupeChecker.Exists(CStr(rCheck.Value)) Then
        CheckDupe = dDupeChecker(CStr(rCheck.Value))
    Else
        CheckDupe = "Ok, not a duplicate"
    End If
End Function

Sub SetUpDictionary()

Dim rFindOn As Excel.Range
Dim rLookAt As Excel.Range

Set dDupeChecker = New Scripting.Dictionary

Set rFindOn = Range("a1:a10")

For Each rLookAt In rFindOn.Cells
    If dDupeChecker.Exists(CStr(rLookAt.Value)) Then
        dDupeChecker(CStr(rLookAt.Value)) = dDupeChecker(CStr(rLookAt.Value)) & "," & rLookAt.Address
    Else
        dDupeChecker.Add CStr(rLookAt.Value), rLookAt.Address
    End If
Next rLookAt

End Sub