Finding Customers with the same name

D

Dan Swartz

Board Regular
Joined
Apr 17, 2020
Messages
53
Office Version
  1. 365
Platform
  1. Windows
I have a userform for pulling a customer's information. it works great. But if I have two or more customers with the same name. It only finds the first name. I live in a community of Amish. It's not uncommon to have 5 - 10 customers with the same name.

I don't even know where to start.

Is there a way to search for a name, display all customers with the same name, but show their address so i would know which customer is the correct one and then be able to choose that customer?

This is my code for the current Customer Form.

VBA Code: 
Private Sub FindCust_Click()
    
  Dim f As Range
  
  If CustomerName.Value = "" Then
    MsgBox "Please enter a customer name"
    CustomerName.SetFocus
    Exit Sub
  End If
  
  Set f = Sheet2.Range("A:A").Find(CustomerName.Value, , xlValues, xlWhole, , , False)
  If Not f Is Nothing Then
    Address1.Text = Sheet2.Cells(f.Row, 2).Value
    Address2.Text = Sheet2.Cells(f.Row, 3).Value
    City.Text = Sheet2.Cells(f.Row, 4).Value
    State.Text = Sheet2.Cells(f.Row, 5).Value
    Zip.Text = Sheet2.Cells(f.Row, 6).Value
    Email.Text = Sheet2.Cells(f.Row, 7).Value
  Else
    MsgBox ("Customer does not exist"), vbOKOnly
    CustomerName.SetFocus
  End If
End Sub
 
Sort by date Sort by votes
@Akuini You are amazing! I can only hope to know VBA someday as well as you do. I can't way to get my lessons started! thank you so much for your help! One issue that is still present but is so small. it works with the way you have it written. but could cause confusion. If there are users with the same name, Listbox1 where it list them does not pull the proper address to correspond to the name. So either it should pull the address or just not display the address at all because when you click on those names. they populate in the rest of the form. but I like the idea of having the address in the listbox 1 as well.
 

Attachments

  • Customers.png
    Customers.png
    37.6 KB · Views: 7
  • Multiple Users.png
    Multiple Users.png
    17.8 KB · Views: 7
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Dan Swartz said:
One issue that is still present but is so small. it works with the way you have it written. but could cause confusion. If there are users with the same name, Listbox1 where it list them does not pull the proper address to correspond to the name.
Click to expand...
Did you update the data, in this case Bryan Cayson address, then when you searched again the address still displayed the old ones?
Actually the code hasn't got to the update part. Basically after updating we need to refresh the list in the combobox.
 
Upvote 0
Akuini said:
Did you update the data, in this case Bryan Cayson address, then when you searched again the address still displayed the old ones?
Actually the code hasn't got to the update part. Basically after updating we need to refresh the list in the combobox.
Click to expand...
If you use your initial screenshot for Adam Parker. the only address correct is the very first one. the rest are all off. and Yes. I did refresh. It's still not displaying correctly.
 
Upvote 0
Dan Swartz said:
If you use your initial screenshot for Adam Parker. the only address correct is the very first one. the rest are all off.
Click to expand...
Ah, you're right, the code is flawed.
Replace all the code in the Userform1 with this:
VBA Code: 
Option Explicit

Private txName As String
Private tbl_CustomerDB As Object
Private nFlag As Boolean
Private d As Object
Private vList
Private aryHeader
Private sCode As String

Private Sub CmdUpdateCust_Click()
'your code to update data
Call create_List
End Sub

Private Sub ComboBox1_Click()
    If ComboBox1.ListIndex > -1 Then
        toFilter
    End If
End Sub

Private Sub UserForm_Initialize()
Dim p As Long, x, i As Long

aryHeader = Split("\Code\CustomerName\Address1\Address2\City\State\Zip\Email", "\") 'array of textboxes name
Set tbl_CustomerDB = Sheets("CustomerDB").ListObjects(1)

With ListBox1
    .ColumnCount = 2         'code & address1
    .ColumnWidths = "40,150" 'arrange columns width
    .IntegralHeight = False
End With

Label1.ForeColor = vbBlue
Label1.Caption = ""

Call create_List

End Sub

Sub create_List()
Dim va, x
ListBox1.Clear
ListBox1.Enabled = False
ComboBox1.Clear
ComboBox1.Value = Empty
Label1.Caption = Empty

With tbl_CustomerDB.DataBodyRange
    .Sort Key1:=.Columns(2), Order1:=xlAscending, Key2:=.Columns(1), Order1:=xlAscending, Header:=xlYes

    va = tbl_CustomerDB.DataBodyRange.Columns(2).Value
        
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
End With

         Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbBinaryCompare
         For Each x In va
            d(x) = Empty
         Next
       
         If d.Exists("") Then d.Remove ""
         vList = d.keys
         With ComboBox1
            .List = vList
            .MatchEntry = fmMatchEntryNone
            .SetFocus
         End With
         d.RemoveAll
End Sub

Private Sub ComboBox1_Change()
Dim i As Long
With ComboBox1
    txName = UCase(Trim(.Text))
   
        If nFlag = False Then  'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key

            If txName <> "" Then
                    Call get_filterX
                    .List = d.keys
                    d.RemoveAll
                    .DropDown
            Else
                    .List = vList   'if combobox1 is empty then get whole list
            End If
        End If
       
        If .ListIndex > -1 Then
            toFilter
            If sCode <> Empty Then
                populate_Textbox
            Else
                'clear Textbox array
                For i = 1 To UBound(aryHeader)
                    Me.Controls(aryHeader(i)).Text = Empty
                Next
            End If
            ListBox1.Clear
        End If
  
End With
   
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

nFlag = False
    Select Case KeyCode

        Case vbKeyDown, vbKeyUp
             nFlag = True 'don't change the list when ComboBox1 value is changed by DOWN ARROW or UP ARROW key
        
    End Select
End Sub

Sub get_filterX()
'search without keyword order, case insensitive
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
Dim tx As String
   
    d.RemoveAll
    tx = Replace(UCase(ComboBox1.Value), " ", "*") & "*"

    For Each x In vList
         v = UCase(x)
         If v Like tx Then d(x) = Empty
    Next

End Sub

Sub toFilter()
Dim i As Long, j As Long, h As Long, p As Long
Dim va, vb, z, zz, w
Dim msg As String
Dim flag As Boolean

With ListBox1
   
    va = tbl_CustomerDB.DataBodyRange.Columns("A:C").Value
    .Clear
 
    For i = 1 To UBound(va, 1)
        If UCase(va(i, 2)) = txName Then
            h = h + 1  'put filtered data col A & C (exclude col B) at the top of va
                va(h, 1) = va(i, 1)
                va(h, 2) = va(i, 3)
        End If
    Next
           
    If h = 1 Then
        .Enabled = False
        .BackColor = RGB(230, 235, 231)
        Label1.Caption = "Found 1 entry of " & txName
        sCode = va(1, 1)
    Else
        .Enabled = True
        .BackColor = vbWhite
        sCode = Empty
        ReDim vb(1 To h, 1 To 2)
        For i = 1 To h
            vb(i, 1) = va(i, 1)
            vb(i, 2) = va(i, 2)
        Next
   
        ListBox1.List = vb
        Label1.Caption = "Found " & h & " entries of " & txName
    End If
   
End With
'Application.StatusBar = Timer - t
End Sub

Sub populate_Textbox()
Dim c As Range, f As Range
Dim va
Dim i As Long
        Set c = tbl_CustomerDB.DataBodyRange.Columns(1).Find(sCode, LookIn:=xlValues, _
        lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
        If Not c Is Nothing Then
            va = c.Resize(1, 12)
            For i = 1 To UBound(aryHeader)
                Me.Controls(aryHeader(i)).Text = va(1, i)
            Next
        End If
        sCode = Empty
End Sub


Private Sub ListBox1_Click()
    sCode = ListBox1.List(ListBox1.ListIndex, 0)
    Call populate_Textbox
End Sub

Private Sub ListBox1_Enter()
    With ListBox1
        If .ListIndex = -1 Then .ListIndex = 0
            sCode = .List(0, 0)
            Call populate_Textbox
    End With
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

I added a line to refresh the list in this part:
Rich (BB code): 
Private Sub CmdUpdateCust_Click()
'your code to update data
Call create_List
End Sub
It means, after updating data the code will refresh the list in the combobox by calling Sub create_List.

You haven't answered my question:
When you update specific customer data using the Userform, what information do you usually have at hand? I assumed the name and address.
 
Upvote 0
Solution
Akuini said:
Ah, you're right, the code is flawed.
Replace all the code in the Userform1 with this:
VBA Code: 
Option Explicit

Private txName As String
Private tbl_CustomerDB As Object
Private nFlag As Boolean
Private d As Object
Private vList
Private aryHeader
Private sCode As String

Private Sub CmdUpdateCust_Click()
'your code to update data
Call create_List
End Sub

Private Sub ComboBox1_Click()
    If ComboBox1.ListIndex > -1 Then
        toFilter
    End If
End Sub

Private Sub UserForm_Initialize()
Dim p As Long, x, i As Long

aryHeader = Split("\Code\CustomerName\Address1\Address2\City\State\Zip\Email", "\") 'array of textboxes name
Set tbl_CustomerDB = Sheets("CustomerDB").ListObjects(1)

With ListBox1
    .ColumnCount = 2         'code & address1
    .ColumnWidths = "40,150" 'arrange columns width
    .IntegralHeight = False
End With

Label1.ForeColor = vbBlue
Label1.Caption = ""

Call create_List

End Sub

Sub create_List()
Dim va, x
ListBox1.Clear
ListBox1.Enabled = False
ComboBox1.Clear
ComboBox1.Value = Empty
Label1.Caption = Empty

With tbl_CustomerDB.DataBodyRange
    .Sort Key1:=.Columns(2), Order1:=xlAscending, Key2:=.Columns(1), Order1:=xlAscending, Header:=xlYes

    va = tbl_CustomerDB.DataBodyRange.Columns(2).Value
       
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
End With

         Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbBinaryCompare
         For Each x In va
            d(x) = Empty
         Next
      
         If d.Exists("") Then d.Remove ""
         vList = d.keys
         With ComboBox1
            .List = vList
            .MatchEntry = fmMatchEntryNone
            .SetFocus
         End With
         d.RemoveAll
End Sub

Private Sub ComboBox1_Change()
Dim i As Long
With ComboBox1
    txName = UCase(Trim(.Text))
  
        If nFlag = False Then  'don't change the list when combobox1 value is changed by DOWN ARROW or UP ARROW key

            If txName <> "" Then
                    Call get_filterX
                    .List = d.keys
                    d.RemoveAll
                    .DropDown
            Else
                    .List = vList   'if combobox1 is empty then get whole list
            End If
        End If
      
        If .ListIndex > -1 Then
            toFilter
            If sCode <> Empty Then
                populate_Textbox
            Else
                'clear Textbox array
                For i = 1 To UBound(aryHeader)
                    Me.Controls(aryHeader(i)).Text = Empty
                Next
            End If
            ListBox1.Clear
        End If
 
End With
  
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

nFlag = False
    Select Case KeyCode

        Case vbKeyDown, vbKeyUp
             nFlag = True 'don't change the list when ComboBox1 value is changed by DOWN ARROW or UP ARROW key
       
    End Select
End Sub

Sub get_filterX()
'search without keyword order, case insensitive
Dim i As Long, x, z, q
Dim v As String
Dim flag As Boolean
Dim tx As String
  
    d.RemoveAll
    tx = Replace(UCase(ComboBox1.Value), " ", "*") & "*"

    For Each x In vList
         v = UCase(x)
         If v Like tx Then d(x) = Empty
    Next

End Sub

Sub toFilter()
Dim i As Long, j As Long, h As Long, p As Long
Dim va, vb, z, zz, w
Dim msg As String
Dim flag As Boolean

With ListBox1
  
    va = tbl_CustomerDB.DataBodyRange.Columns("A:C").Value
    .Clear
 
    For i = 1 To UBound(va, 1)
        If UCase(va(i, 2)) = txName Then
            h = h + 1  'put filtered data col A & C (exclude col B) at the top of va
                va(h, 1) = va(i, 1)
                va(h, 2) = va(i, 3)
        End If
    Next
          
    If h = 1 Then
        .Enabled = False
        .BackColor = RGB(230, 235, 231)
        Label1.Caption = "Found 1 entry of " & txName
        sCode = va(1, 1)
    Else
        .Enabled = True
        .BackColor = vbWhite
        sCode = Empty
        ReDim vb(1 To h, 1 To 2)
        For i = 1 To h
            vb(i, 1) = va(i, 1)
            vb(i, 2) = va(i, 2)
        Next
  
        ListBox1.List = vb
        Label1.Caption = "Found " & h & " entries of " & txName
    End If
  
End With
'Application.StatusBar = Timer - t
End Sub

Sub populate_Textbox()
Dim c As Range, f As Range
Dim va
Dim i As Long
        Set c = tbl_CustomerDB.DataBodyRange.Columns(1).Find(sCode, LookIn:=xlValues, _
        lookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
        If Not c Is Nothing Then
            va = c.Resize(1, 12)
            For i = 1 To UBound(aryHeader)
                Me.Controls(aryHeader(i)).Text = va(1, i)
            Next
        End If
        sCode = Empty
End Sub


Private Sub ListBox1_Click()
    sCode = ListBox1.List(ListBox1.ListIndex, 0)
    Call populate_Textbox
End Sub

Private Sub ListBox1_Enter()
    With ListBox1
        If .ListIndex = -1 Then .ListIndex = 0
            sCode = .List(0, 0)
            Call populate_Textbox
    End With
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

I added a line to refresh the list in this part:
Rich (BB code): 
Private Sub CmdUpdateCust_Click()
'your code to update data
Call create_List
End Sub
It means, after updating data the code will refresh the list in the combobox by calling Sub create_List.

You haven't answered my question:
When you update specific customer data using the Userform, what information do you usually have at hand? I assumed the name and address.
Click to expand...
Thanks. I will update this.
Sorry...I misunderstood your question. I wouldn't add any new customers without their full address. this form would be intended to add a phone number or Email later. That's something that is not always available right away. but the main use of this form will be to update any information that may change. like their email changes or they move or they get a new phone number etc. but anything could be updated at any given time. Does that make sense?
 
Upvote 0
@Akuini I'm going to take this code and put it into my sheet with all my information. Hopefully, I know what I'm doing! :) one other question. I know it's a separate code. but how do I get the customer ID to auto-populate to the next number when I add a customer? I would like to have the code find the next number and increase it by 1. I know how to do it when it's just a number. but when there is a letter in front. I can't figure it out.
 
Upvote 0
Dan Swartz said:
I would like to have the code find the next number and increase it by 1.
Click to expand...
Try this code;

VBA Code: 
Sub new_customer_code()
Dim cn As String
Dim c As Range
With tbl_CustomerDB.DataBodyRange
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes 'Make sure that table CustomerDB is sorted ascending by col A
End With

Set c = Sheets("CustomerDB").Range("A:A").Find(What:="C*", LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
cn = "C" & Format(Val(Mid(c.Value, 2)) + 1, "00000") 'create new customer code

Debug.Print cn
End Sub
 
Upvote 0
Akuini said:
Try this code;

VBA Code: 
Sub new_customer_code()
Dim cn As String
Dim c As Range
With tbl_CustomerDB.DataBodyRange
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes 'Make sure that table CustomerDB is sorted ascending by col A
End With

Set c = Sheets("CustomerDB").Range("A:A").Find(What:="C*", LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
cn = "C" & Format(Val(Mid(c.Value, 2)) + 1, "00000") 'create new customer code

Debug.Print cn
End Sub
Click to expand...
I'll give that a try when I get home tonight! I have to run do some errands! Thank you again! You're amazing!
 
Upvote 0
Sorry, I forgot to refer to the table CustomerDB properly. Use this one instead:
VBA Code: 
Sub new_customer_code()
Dim cn As String
Dim c As Range
With Sheets("CustomerDB").ListObjects(1).DataBodyRange
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes 'Make sure that table CustomerDB is sorted ascending by col A
    Set c = .Columns(1).Find(What:="C*", LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
End With
cn = "C" & Format(Val(Mid(c.Value, 2)) + 1, "00000") 'create new customer code
Debug.Print cn
End Sub
 
Upvote 0
Another thing that I forgot;):
I should dim tbl_CustomerDB as ListObject instead of Object, so in the code (post#34) :
Change this part:
VBA Code: 
Private tbl_CustomerDB As Object
to this:
VBA Code: 
Private tbl_CustomerDB As ListObject
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Pulling info from a Sheet into UserForm
Replies
4
Views
482
Dan Swartz
D
I
  • Question Question
Userform does not show leading 0 for telephone number
Replies
1
Views
272
ipbr21054
I
I
  • Question Question
Vba has stopped adding hyperlink to my customers name
Replies
3
Views
102
ipbr21054
I
hendrikbez
  • Question Question
Cannot get to edit on my user form with 1 to 5 members on it
Replies
1
Views
268
Anthony47
A
K
  • Question Question
how to copy above cell values down
Replies
5
Views
350
kamranyd
K

Forum statistics

Threads
1,224,606
Messages
6,179,862
Members
452,948
Latest member
UsmanAli786

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top