Find duplicate name & populate listbox

[ipbr21054]

Hi,
I am using the code shown below which works well but wondering if it can be used / edited or just start again.
Currently the code looks in Column B for dupliacte names & the cell colour is shown white for the user to see.
As my list is getting longer i think it best to populate a listbox with the duplicate names & the row they are in.

Many thanks if you could advise

Private Sub DuplicateNameSearch_Click()
Unload PostageLinkForm
    Dim cell As Variant
    Dim Source As Range
    Dim dups As Long

    Set Source = Range("B8:B5000")

    For Each cell In Source
        If Application.WorksheetFunction.CountIf(Source, cell) > 1 Then
            cell.Interior.Color = RGB(255, 255, 255)
            dups = dups + 1
        End If
    Next cell
    
    If dups > 0 Then
        MsgBox " DUPLICATE NAMES WERE FOUND & HAVE BEEN HIGHLIGHTED " & vbNewLine & "********** WHITE IN COLUMN B FOR YOU TO CHECK **********", vbCritical, "POSTAGE DUPLICATE CHECKER"
    Else
        MsgBox " NO DUPLICATE CUSTOMER NAMES WERE FOUND ", vbInformation, "POSTAGE DUPLICATE CUSTOMER NAME CHECKER"
    End If

End Sub

 

[ipbr21054]

Hi,
Ive gone with this but i have a mistake for which can you advise please.

Private Sub DuplicateNameSearch_Click()
Unload PostageLinkForm
    Dim dict As Object
    Dim LR As Long, i As Long, v As Variant, strResult As String
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    With Sheets("POSTAGE")
        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 & "Duplicate Name Found: " & vbNewLine & "" & v & "   At Row:  " & _
            Left(dict.Item(v), Len(dict.Item(v)) - 1) & vbNewLine & vbNewLine
    Next v
    MsgBox strResult, vbInformation, "DUPLICATE NAME CHECKER"
    
End Sub

All works fine apart from when there is no duplicate i see the MsgBox as supplied in screenshot.

I need to add a message etc but dont see how with the code im using

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[ipbr21054]

Hi,
What do you see that is different to adding a photo or screen shot ?

I thought I did explain it.
The code works fine in respect of finding duplicates and then advise the user the name of the duplicate & the row they are in.

The issue is when no duplicates are found the msgbox is shown as in the photo supplied.
Just a blank msgbox with the OK button.
I was trying to implement some text on the msgbox like No duplicates were found.

 

[mumps]

If I didn't feel it would help, I wouldn't have asked. It is hard to work with a picture. A screen shot would allow me to copy paste your data into Excel so that I could test a possible solution. Your code looks overly complicated for what you are trying to do. If I can see what your data looks like, I would be able to make a more clear decision.

 

[ipbr21054]

I will switch the pc on and send some info.

I wasn’t being rude it was just question of what is the difference between what I did & doing what you said.

I wasn’t supposed to come across as what difference does it make I will do it my way.

I was asking what the difference was in the two different options.

 

[ipbr21054]

Here the information for you.
My worksheet is called POSTAGE.
I have headers at Row 7
The data starts at Row 8 then down the page currently to Row 1713 but will increase each day.
Column B is where the customers name are.

The goal is to find if any customers have been duplicated.
Currently with the code in use the customers name is shown & the row number for where the duplicates are.

Would be nice to be able to select a customers name & be taken to that customer of the worksheet so i can then make the edit.
This is why i initally was going to have them populated into a listbox

 

[mumps]

Insert a Listbox (ActiveX Control) on your sheet. Place the macro below in the worksheet code module:

Private Sub ListBox1_Change()
    Range("B:B").Find(ListBox1.Value, searchorder:=xlByRows, searchdirection:=xlPrevious).Select
End Sub

Place this macro in a regular module:

Sub ChangeData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, v As Variant, i As Long
    LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    v = Range("B8:B" & LastRow).Value
    ActiveSheet.ListBox1.Clear
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v, 1)
            If Not .Exists(v(i, 1)) Then
                .Add v(i, 1), Nothing
            Else
                ActiveSheet.ListBox1.AddItem v(i, 1)
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

Insert a button on your sheet and assign the macro to that button. When you click the button, the listbox will be populated with the duplicate items. When you click on any item in the listbox, that cell will be selected for you to edit.

 

[ipbr21054]

Thanks very much for that.
Have a nice day

 

[mumps]

You are very welcome.