Add in VBA Code to check zip code against pre-determined list

[mikefisher]

Hi all.
I have a User Form in VBA and I want to check the zipcode box entry against a list of pre-determined zipcodes to ensure that they are valid... I also need to allow ALL zipcodes that are more than 6 digits long. Any ideas?

here is my current code

'This is the newaccnt form code. This is the code that runs when the user clicks the 'Add/Edit' button
'on the 'Orders' Sheet. Each sub is enacted when one of the buttons is clicked. These subs are ordered
'as follows:
'-Add Button
'-Close Button
'-Clear Button
'-Delete Button
'-Search Button
'-Update Button

'''''Add Sub'''''

'Adds a new order

Private Sub addb_Click()
Dim ws As Worksheet
Dim table_row As ListRow
Dim table_object As ListObject
Dim rngIDlist As Range
Dim rngID As Range
Dim newboxval As String
Set ws = Sheets("Orders") '<~~ Set Sheet

'Check to see if order number is blank
If Len(Trim(Me.ordernmberblank)) = 0 Then
MsgBox "Please enter an order number."
Exit Sub
End If

'Find order number in data
Set rngIDlist = ws.Range([c1], [c8].End(xlDown)) 'change x in '[cx].xlDown' to where data starts
Set rngID = rngIDlist.Find(Me.ordernmberblank.Value, SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)


'Check to see if order exists
'If it does, direct user towards Update button
If Not rngID Is Nothing Then
MsgBox ("Order number " & Me.ordernmberblank & " already exists." & vbCrLf & _
"Use the Update button to update the order.")
Exit Sub
End If

'Check if value of order is a number
If IsNumeric(Me.ordernmberblank) = False Then
Me.ordernmberblank.SetFocus
MsgBox "Please enter a number for order number"
Exit Sub
End If

'Find last row and add a row
irow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'Set new customer box value
If Me.newbox.Value = True Then
newboxval = "Yes"
Else
newboxval = "No"
End If

'Check if value of selling price is a number
If IsNumeric(Me.sellingprice) = False Then
Me.sellingprice.SetFocus
MsgBox "Please enter a number for selling price"
Exit Sub
End If

'Check if value of 5 point categories are numbers
If IsNumeric(Me.zipcode) = False Then
Me.zipcode.SetFocus
MsgBox "Please enter a 5 digit zipcode"
Exit Sub
End If

If IsNumeric(Me.contest) = False Then
Me.contest.SetFocus
MsgBox "Please enter a number for contest points"
Exit Function
End If

If IsNumeric(Me.pay) = False Then
Me.pay.SetFocus
MsgBox "Please enter a number for pay points"
Exit Function
End If

If IsNumeric(Me.imagecare) = False Then
Me.imagecare.SetFocus
MsgBox "Please enter a number for imageCARE points"
Exit Function
End If

If IsNumeric(Me.production) = False Then
Me.production.SetFocus
MsgBox "Please enter a number for production points"
Exit Function
End If

If IsNumeric(Me.NewTokens) = False Then
Me.NewTokens.SetFocus
MsgBox "Please enter a number for New Customer Tokens points"
Exit Function
End If

'Check if Date of Sale and Install Date are valid dates
If IsDate(Me.saledate) = False Then
Me.saledate.SetFocus
MsgBox "Please enter a valid date for date of sale"
Exit Function
End If

'Check zip code against list


'Fill text boxes
ws.Unprotect
With ws
Cells(irow, 1).Value = Me.accntnameblank.Value
Cells(irow, 2).Value = newboxval
Cells(irow, 3).Value = Me.ordernmberblank.Value
Cells(irow, 4).Value = Me.sellingprice.Value
Cells(irow, 5).Value = Me.zipcode.Value
Cells(irow, 6).Value = Me.contest.Value
Cells(irow, 7).Value = Me.pay.Value
Cells(irow, 8).Value = Me.saledate.Value
Cells(irow, 9).Value = Me.comments.Value
Cells(irow, 10).Value = Me.branch.Value
Cells(irow, 11).Value = Me.accountexecutive.Value
Cells(irow, 12).Value = Me.NewTokens.Value
Cells(irow, 13).Value = Me.imagecare.Value
Cells(irow, 14).Value = Me.production.Value
End With

MsgBox ("Added order for: " & Me.accntnameblank.Value)
ws.Protect AllowSorting:=True, AllowFiltering:=True, Contents:=True
'Unfill text boxes
Me.accntnameblank.Value = ""
Me.newbox.Value = False
Me.ordernmberblank.Value = ""
Me.sellingprice.Value = ""
Me.zipcode.Value = ""
Me.contest.Value = ""
Me.pay.Value = ""
Me.saledate.Value = ""
Me.comments.Value = ""
Me.branch.Value = ""
Me.accountexecutive.Value = ""
Me.NewTokens.Value = ""
Me.imagecare.Value = ""
Me.production.Value = ""
Me.accntnameblank.SetFocus

End Function

'''''Close Button Sub'''''

'Closes the form

Private Sub cancelb_Click()
Unload Me
End Sub

'''''Clear Button Sub'''''

'Clear all current fields in the form

Private Sub clearbtn_Click()
Me.accntnameblank.Value = ""
Me.newbox.Value = False
Me.ordernmberblank.Value = ""
Me.sellingprice.Value = ""
Me.zipcode.Value = ""
Me.contest.Value = ""
Me.pay.Value = ""
Me.saledate.Value = ""
Me.comments.Value = ""
Me.branch.Value = ""
Me.accountexecutive.Value = ""
Me.NewTokens.Value = ""
Me.imagecare.Value = ""
Me.production.Value = ""
Me.accntnameblank.SetFocus
End Sub

'''''Delete Button Sub'''''

'Deletes an order based on the order number in the order number field

Private Sub deletebtn_Click()

'Check if order number is blank
If Len(Trim(Me.ordernmberblank)) = 0 Then
MsgBox "Please enter an existing order number to delete."
Exit Sub
End If

Dim ws As Worksheet
Dim rngIDlist As Range
Dim rngID As Range
Dim msg As String


Set ws = Sheets("Orders") 'Set as sheet

'Find order number in data
Set rngIDlist = ws.Range([c1], [c8].End(xlDown)) 'change x in '[cx].xlDown' to where data starts
Set rngID = rngIDlist.Find(Me.ordernmberblank, SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues)

'Check to see if order exists
'If order exists delete row after checking with user
If rngID Is Nothing Then
MsgBox ("Order number " & Me.ordernmberblank & " does not exist.")
Exit Sub
Else
msg = ("Are you sure you want to delete order number: " & Me.ordernmberblank & _
"? Doing so may affect commission check predictions on the 'PayChecks' sheet.")
If MsgBox(msg, vbYesNo) = vbNo Then
Exit Sub
Else
ws.Unprotect
rngID.EntireRow.Delete
MsgBox "Order number " & Me.ordernmberblank.Value & " deleted."
ws.Protect AllowSorting:=True, AllowFiltering:=True, Contents:=True
End If
End If

'Reset values
Me.accntnameblank.Value = ""
Me.newbox.Value = False
Me.ordernmberblank.Value = ""
Me.sellingprice.Value = ""
Me.zipcode.Value = ""
Me.contest.Value = ""
Me.pay.Value = ""
Me.saledate.Value = ""
Me.comments.Value = ""
Me.branch.Value = ""
Me.accountexecutive.Value = ""
Me.NewTokens.Value = ""
Me.imagecare.Value = ""
Me.production.Value = ""
Me.accntnameblank.SetFocus
End Sub

'''''Search Button Sub'''''

'Searches the table for data matching the selected order number

Private Sub findaccnt_Click()

'Check to see if order number is blank
If Len(Trim(Me.ordernmberblank)) = 0 Then
MsgBox "Please enter an order number to search."
Exit Sub
End If

Dim ws As Worksheet
Dim rngIDlist As Range
Dim rngID As Range
Dim newboxval As Boolean 'note newboxval is a boolean here

Set ws = Sheets("Orders") 'Set as sheet name

'Find order number in data
Set rngIDlist = ws.Range([c1], [c8].End(xlDown)) 'change x in '[cx].xlDown' to where data starts
Set rngID = rngIDlist.Find(Me.ordernmberblank, SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

'Check to see if order exists
'If order exists fill data
If rngID Is Nothing Then
MsgBox ("Order number " & Me.ordernmberblank & " does not exist.")
Exit Sub
Else
'Set new customer box value
If rngID.Offset(0, -1) = "Yes" Then
newboxval = True
Else
newboxval = False
End If
Me.accntnameblank.Value = rngID.Offset(0, -2)
Me.ordernmberblank.Value = rngID.Offset(0, 0)
Me.sellingprice.Value = rngID.Offset(0, 1)
Me.zipcode.Value = rngID.Offset(0, 2)
Me.contest.Value = rngID.Offset(0, 3)
Me.pay.Value = rngID.Offset(0, 4)
Me.saledate.Value = rngID.Offset(0, 5)
Me.comments.Value = rngID.Offset(0, 6)
Me.branch.Value = rngID.Offset(0, 7)
Me.accountexecutive.Value = rngID.Offset(0, 8)
Me.NewTokens.Value = rngID.Offset(0, 9)
Me.imagecare.Value = rngID.Offset(0, 10)
Me.production.Value = rngID.Offset(0, 11)
Me.newbox.Value = newboxval
End If

End Sub

'''''Update Button Sub'''''

'Updates the order in the order number field with new information

Private Sub updatebtn_Click()

'Check to see if order number is blank
If Len(Trim(Me.ordernmberblank)) = 0 Then
MsgBox "Please enter an existing order number to update."
Me.ordernmberblank.SetFocus
Exit Sub
End If

Dim ws As Worksheet
Dim rngIDlist As Range
Dim rngID As Range
Dim newboxval As String 'Note newboxval is a string here

Set ws = Sheets("Orders") 'Set as sheet

'Find order number in data
Set rngIDlist = ws.Range([c1], [c8].End(xlDown)) 'change x in '[cx].xlDown' to where data starts
Set rngID = rngIDlist.Find(Me.ordernmberblank, SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)

'Set new customer box value
If Me.newbox.Value = True Then
newboxval = "Yes"
Else
newboxval = "No"
End If

'Check to see if order exists
'If it does not, direct user towards Add button
If rngID Is Nothing Then
MsgBox ("Order number " & Me.ordernmberblank & " does not exist." & vbCrLf & _
"Use the Add button to enter a new order.")
Exit Sub
End If

'Check if value of selling price is a number
If IsNumeric(Me.sellingprice) = False Then
Me.sellingprice.SetFocus
MsgBox "Please enter a number for selling price"
Exit Sub
End If

'Check if value of order is a number
If IsNumeric(Me.ordernmberblank) = False Then
Me.ordernmberblank.SetFocus
MsgBox "Please enter a number for order number"
Exit Sub
End If

'Check if value of 3 point categories are numbers
If IsNumeric(Me.zipcode) = False Then
Me.zipcode.SetFocus
MsgBox "Please enter a 5 digit zipcode"
Exit Sub
End If

If IsNumeric(Me.contest) = False Then
Me.contest.SetFocus
MsgBox "Please enter a number for contest points"
Exit Sub
End If

If IsNumeric(Me.pay) = False Then
Me.pay.SetFocus
MsgBox "Please enter a number for pay points"
Exit Sub
End If

If IsNumeric(Me.imagecare) = False Then
Me.imagecare.SetFocus
MsgBox "Please enter a number for imageCARE points"
Exit Sub
End If

If IsNumeric(Me.production) = False Then
Me.production.SetFocus
MsgBox "Please enter a number for production points"
Exit Sub
End If

If IsNumeric(Me.NewTokens) = False Then
Me.NewTokens.SetFocus
MsgBox "Please enter a number for New Customer Tokens points"
Exit Sub
End If

'Check if Date of Sale and Install Date are valid dates
If IsDate(Me.saledate) = False Then
Me.saledate.SetFocus
MsgBox "Please enter a valid date for sale date"
Exit Sub

End If


'Update cells
ws.Unprotect
rngID.Offset(0, -2) = Me.accntnameblank.Value
rngID.Offset(0, -1) = newboxval
rngID.Offset(0, 0) = Me.ordernmberblank.Value
rngID.Offset(0, 1) = Me.sellingprice.Value
rngID.Offset(0, 2) = Me.zipcode.Value
rngID.Offset(0, 3) = Me.contest.Value
rngID.Offset(0, 4) = Me.pay.Value
rngID.Offset(0, 5) = Me.saledate.Value
rngID.Offset(0, 6) = Me.comments.Value
rngID.Offset(0, 7) = Me.branch.Value
rngID.Offset(0, 8) = Me.accountexecutive.Value
rngID.Offset(0, 9) = Me.NewTokens.Value
rngID.Offset(0, 10) = Me.imagecare.Value
rngID.Offset(0, 11) = Me.production.Value
ws.Protect AllowSorting:=False, AllowFiltering:=False, Contents:=True

MsgBox "Order number " & Me.ordernmberblank.Value & " updated."

End Sub

'Set AE Dropdown as dependant on Branch Dropdown


Private Sub branch_change()
Select Case branch.Value
Case Is = "Appleton"
accountexecutive.RowSource = "AppletonAE"
Case Is = "Iowa"
accountexecutive.RowSource = "IowaAE"
Case Is = "Indy"
accountexecutive.RowSource = "IndyAE"
Case Is = "Ohio"
accountexecutive.RowSource = "OhioAE"
Case Is = "Milwaukee"
accountexecutive.RowSource = "MilwaukeeAE"
Case Is = "Chicagoland"
accountexecutive.RowSource = "ChicagolandAE"
Case Is = "Madison"
accountexecutive.RowSource = "MadisonAE"
End Select

End Sub





Private Sub UserForm_Click()

End Sub