Prevent Duplicate Customer Names

Hello,

On the Schedule sheet there is option to add new customer with VBA and then option to save. How can this prevent a duplicate customer name?

Also can the customer selection drop down be in last name alphabetical order please?

Any help or suggestions would be appreciated.

I should have asked for a way to check if that customer exists in the system (Contacts sheet). I will try to figure it out sorry for the trouble.

I have no idea how to do that in the save code.

Thank you I will try in the morning.

Also as an option:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Contacts As Worksheet: Set Contacts = ThisWorkbook.Worksheets("Contacts")
    If Target.CountLarge > 1 Then Exit Sub
    
    If Not Intersect(Target, Range("E13")) Is Nothing Then
        
        If Application.WorksheetFunction.CountIf(Contacts.Range("B:B"), Target) > 0 Then
            Application.Goto Target
            MsgBox " Contact " & Target & " Already Exits! ", vbExclamation
        Else
            MsgBox " Contact " & Target & " is new in Contacts List", vbInformation
        End If
    
    Else
        If Not Intersect(Target, Range("E3")) Is Nothing And Range("E3").Value <> Empty Then Contact_Load    'Load Contact Details
    End If

    Set Contacts = Nothing
End Sub

Write the given code to the Schedule Sheet Module. Good Luck.

I tried John Topley's solution. There is an issue though. The calendar has appointments that can be selected to show the details of that appointment. When clicking the popup shows that customer exists.

billy60

Prevent Duplicate Customer Names

Is it like that simple?
If you are managing Appointment not to overwrap for the Customer then
1)
Insert bold lines in "Sub Appt_SaveUpdate"

    End If
    Dim s
    s = AppExists(Schedule.[e3], Schedule.[e5], Schedule.[e6], Schedule.[e7])
    If s <> "" Then MsgBox "Appoint overwrapping" & vbLf & s, vbCritical: Exit Sub
    Appts.Range("B" & ApptRow).Value = .Range("B12").Value 'Set Contact ID

2) Add below to the same code module

Function AppExists(sName, sDate, sTime, eTime) As String
    Dim x, i As Long
    With Appts.[a3].CurrentRegion
        x = Filter(Appts.Evaluate("transpose(if((" & .Columns(3).Address & "=""" & sName & """)*" & _
        "(" & .Columns(4).Address & "=" & CLng(sDate) & "),row(1:" & .Rows.Count & ")))"), False, 0)
        If UBound(x) = -1 Then Exit Function
        For i = 0 To UBound(x)
            If ((sTime >= .Cells(x(i), 5)) * (sTime <= .Cells(x(i), 6))) + _
                ((eTime <= .Cells(x(i), 5)) * (eTime <= .Cells(x(i), 6))) Then
                AppExists = AppExists & vbLf & Join(Array(.Cells(x(i), 4).Text, _
                    .Cells(x(i), 5).Text, .Cells(x(i), 6).Text))
            End If
        Next
    End With
End Function

3)

Also can the customer selection drop down be in last name alphabetical order please?

Add following lines in Schedule Worksheeet_Activate event procedure.

With [e3]
    .Validation.Delete
    .Validation.Add 3, Formula1:=Join([transpose(unique(sortby(cont_name,mid(cont_name,find(" ",cont_name)+1,len(cont_name)))))], ",")
End With

All above is assuming your other part of codes are all working correctly.