I need a macro that when I run it will check for duplicate names in column b, if a duplicate is found I would like a message box to pop up letting me know there are duplicates and the value in column A they are in. Now the below coding i use but i need the value in column A
Thanks
Dim dict As Object
Dim LR As Long, i As Long, v As Variant, strResult As String
Set dict = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
LR = .Range("b" & .Rows.Count).End(xlUp).Row
For i = 2 To LR
If WorksheetFunction.CountIf(.Columns("b"), .Range("b" & i).Value) > 1 Then
If dict.Exists(.Range("b" & i).Value) Then
dict.Item(.Range("b" & i).Value) = dict.Item(.Range("b" & i).Value) & .Range("b" & i).Row & ","
Else
dict.Add .Range("b" & i).Value, .Range("b" & i).Row & ","
End If
End If
Next i
End With
For Each v In dict.keys
strResult = strResult & "Complaints: " & v & vbNewLine & "Rows: " & _
Left(dict.Item(v), Len(dict.Item(v)) - 1) & vbNewLine & vbNewLine
Next v
MsgBox strResult
Thanks
Dim dict As Object
Dim LR As Long, i As Long, v As Variant, strResult As String
Set dict = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
LR = .Range("b" & .Rows.Count).End(xlUp).Row
For i = 2 To LR
If WorksheetFunction.CountIf(.Columns("b"), .Range("b" & i).Value) > 1 Then
If dict.Exists(.Range("b" & i).Value) Then
dict.Item(.Range("b" & i).Value) = dict.Item(.Range("b" & i).Value) & .Range("b" & i).Row & ","
Else
dict.Add .Range("b" & i).Value, .Range("b" & i).Row & ","
End If
End If
Next i
End With
For Each v In dict.keys
strResult = strResult & "Complaints: " & v & vbNewLine & "Rows: " & _
Left(dict.Item(v), Len(dict.Item(v)) - 1) & vbNewLine & vbNewLine
Next v
MsgBox strResult