Sorry to be such a Newby Rick. Can't get it to run through correctly. Can you spot my problem? This is my whole code.
Code:
Private Sub CommandButton1_Click()

Dim dd As Worksheet
Dim FCL As Worksheet
Dim LCL As Worksheet
Dim supSht As Worksheet
Dim cellNameRng As Range
Dim cellEmailRng As Range

Set dd = Worksheets("Double Drop FCL")
Set FCL = Worksheets("FCL")
Set LCL = Worksheets("LCL")
Set supSht = Worksheets("Supplier | emails")

Application.ScreenUpdating = False

' Find next available cell in column A (Haulier name)
supSht.Visible = xlSheetVisible
supSht.Select

Range("A2").Select
        Do Until ActiveCell.Row = 65536
        Selection.End(xlDown).Select
        Loop
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        ' --------------------------------
        
'set the blank cell to use for next name
Set cellNameRng = ActiveCell
        
'Take name from form and paste to next cell in Supplier sheet
cellNameRng = NewSupplier.TextBoxName.Value

' Find next available cell in column B (email address)
Range("B2").Select
        Do Until ActiveCell.Row = 65536
        Selection.End(xlDown).Select
        Loop
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        ' --------------------------------
        
'set the blank cell to use for next email address
Set cellEmailRng = ActiveCell
        
'Take email from form and paste to next cell in Supplier sheet
cellEmailRng = NewSupplier.TextBoxemailAdd.Value

'Clear the namebox from form
NewSupplier.TextBoxName.Value = ""
'Clear the namebox from form
NewSupplier.TextBoxemailAdd.Value = ""

'Filter haulier name to alphabetical ascending order
Range("A1:B600").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'Hide the form
NewSupplier.Hide

'Hide Supplier sheet
supSht.Visible = xlSheetHidden

ActiveSheet.Unprotect

'expand validation list to the row with new values in

Dim ValListRange As Range
Set ValListRange = ActiveSheet.Range("A201", Columns("A").Find(What:="*", SearchOrder:=xlRows, _
                     SearchDirection:=xlPrevious, LookIn:=xlValues))

With Range("C9:E9").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=ValListRange
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
ActiveSheet.Protect

Application.ScreenUpdating = True

Set dd = Nothing
Set FCL = Nothing
Set LCL = Nothing
Set supSht = Nothing
Set cellNameRng = Nothing
Set cellEmailRng = Nothing

End Sub
p.s. Cell A201 will always be populated thank you. Thanks for your help