Find matching values in one column

[ipbr21054]

I’m looking to find matching values “customers names” in one column.
This column being column A

I can’t use a code where the user would manually enter a customers name as that would take far to long.

The code needs to decipher the names in column A itself.
The code would only need to be interested in customers names that match & have appeared more than once.

The names are saved like so.
TOM JONES 001
BOB SMITH 003

The code would need to ignore the 001 002 003 etc etc part & concentrate on the name.

Maybe best to put these names in a listbox along with its row number ??

What do you think, any advice welcome please.
Thanks.

 

[NoSparks]

Sorry, can't trouble-shoot something I don't have.

 

[ipbr21054]

Within next 5 minutes i will upload a test file.
Please advise once youve downloaded it so i can then delete it

 

[ipbr21054]

Here we go

DOWNLOAD FILE HERE

 

[NoSparks]

Have downloaded, will have a look.

 

[NoSparks]

The issue is your customer KELVIN GOH appearing on 94 lines.
The string of all his row numbers exceeds the 255 character limit of the transpose function.
Perhaps someone else will be able to provide a solution.

Edited to add this:

Just to see, this will bypass KELVIN GOH

Private Sub MoreThanOne_Click()
    Dim lr As Long
    Dim rng As Range, cel As Range
    Dim dic As Object
    Dim cust As String

With Sheets("POSTAGE")
    lr = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    Set rng = .Range("B8:B" & lr)
End With

Set dic = CreateObject("Scripting.Dictionary")

For Each cel In rng
    'just the name
    cust = Trim(Left(cel.Value, Len(cel.Value) - 3))
    'check if name exists in dictionary
    If cust <> "KELVIN GOH" Then            '<~~~ Skip this guy
        If Not dic.Exists(cust) Then
            'if not add it with it's row number
            dic(cust) = " | " & cel.Row
        Else
            'if exists, add this row number also
            dic(cust) = dic(cust) & " | " & cel.Row
        End If
    End If
Next cel

' Write the customer names and row numbers to another sheet
With Sheets("Sheet4")   ' change to suit
    .Range("B2").Resize(dic.count) = Application.Transpose(dic.Keys)  ' the customer names
    .Range("C2").Resize(dic.count) = Application.Transpose(dic.Items) ' the rows they're on
End With
End Sub

 

[ipbr21054]

Thanks will check later.

If this works then I could do him separately on its own manually I think.

Thanks.

 

[Alex Blakenburg]

You have already deleted your file or I could have a look later.
@NoSparks if the only issue is the transpose it should be easy enough to loop through the items putting them out to an array and write that the to spreadsheet.

 

[ipbr21054]

As you bought made the effort to comment at such an early time i made the effort to get up & try it.
I confirm it works.

Many thanks