I have a list of zip codes and a worksheet (main page) with a search box. I have a function to check the zip code is valid (it works so I haven't pasted below). If it is valid but not in my list, a message appears to the right of the search box. If it is in the list I want it to paste into a blank sheet where a lookup returns text from a hidden worksheet which is the cut and paste to the main page. I just can't seem to get it to work, I keep getting an end if block if error. Would really appreciate is anyone could help?
Thanks in advance - this is what I have:
<code>
Private Sub Search_Click()
Sheets("Main Page").Unprotect ("checking zip code")
Sheets("Blank").Unprotect ("checking zip code")
Dim Result As String
Dim ResultArray() As String
Dim Height As Long
Dim Width As Long
Dim x As Long
Dim Status As String
Sheets("Blank").Activate
blDimensioned = False
Result = IsUSZipCode(Sheets("Main Page").SearchBox.Text)
If Result = "You have not entered a valid zip code" Or Result = "The zip code you have entered is too short" Or Result = "Please enter a Zip Code." Then
MsgBox (Result)
Else
If Result <> "Valid" Then
Sheets("Main Page").SearchBox.Text = Result
End If
ResultArray = CheckRecords(Sheets("Main Page").SearchBox.Text)
If ResultArray(0, 0) = "False" Then
Sheets("Main Page").Range("C23").Value = "The zip code entered is not covered"
Sheets("Main Page").Range("R14").Font.Size = 12
Sheets("Main Page").Range("R14:AE15").Font.FontStyle = "Bold"
Sheets("Main Page").Range("R14:AE15").Font.Color = vbYellow
Sheets("Main Page").Range("R14:AE15").Interior.ColorIndex = RGB(115, 188, 102)
Sheets("Main Page").Range("R14:AE15").MergeCells = True
Sheets("Main Page").Range("R14:AE15").WrapText = True
Sheets("Main Page").Range("R14:AE15").HorizontalAlignment = xlCenter
Sheets("Main Page").Range("R14:AE15").VerticalAlignment = xlCenter
Else
End If
If ResultArray(0, 0) = "True" Then
Selection.Sheets("Main Page").SearchBox.Text
Selection.Copy
Sheets("Blank").Paste
Range("B1").Select
Selection.Copy
Columns("A:A").Select
Selection.ClearContents
Sheets("Main Page").Select
Range("R1:AE100").Select
Selection.ClearContents
Range("R14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R14:AE29").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Sheets("Main Page").Activate
End If
Sheets("Main Page").Protect ("checking zip code")
Sheets("Blank").Protect ("checking zip code")
End With
End Sub
'Function to find row of selected list box value
Function CheckRecords(FindItem) As String()
Dim StartRow As Integer
Dim EndRow As Integer
Dim CellValue As String
Dim blDimensioned As Boolean
Dim Values() As String
'Set variable values
ReDim Values(0 To 0, 0 To 0) As String
Values(0, 0) = "False"
blDimensioned = False
'value needed is two. This will avoid column headers being included in matches
StartRow = 2
EndRow = Sheets("List of Zip Codes").Cells(Rows.Count, "A").End(xlUp).Row
FindItem = Trim(Replace(LCase(FindItem), " ", ""))
Do While StartRow <= EndRow
CellValue = Trim(Replace(LCase(Sheets("List of Zip Codes").Cells(StartRow, 1).Value), " ", ""))
If CellValue = FindItem Then
If blDimensioned = True Then
ReDim Preserve Values(0 To 1, 0 To UBound(Values, 2) + 1) As String
Values(0, UBound(Values, 2)) = Sheets("List of Zip Codes").Cells(StartRow, 2).Value
Values(1, UBound(Values, 2)) = Sheets("List of Zip Codes").Cells(StartRow, 3).Value
Else
'No, so dimension it and flag it as dimensioned.
ReDim Values(0 To 1, 0 To 0) As String
Values(0, 0) = Sheets("List of Zip Codes").Cells(StartRow, 2).Value
Values(1, 0) = Sheets("List of Zip Codes").Cells(StartRow, 3).Value
blDimensioned = True
End If
End If
StartRow = StartRow + 1
Loop
CheckRecords = Values
End Function
<code>
Thanks in advance - this is what I have:
<code>
Private Sub Search_Click()
Sheets("Main Page").Unprotect ("checking zip code")
Sheets("Blank").Unprotect ("checking zip code")
Dim Result As String
Dim ResultArray() As String
Dim Height As Long
Dim Width As Long
Dim x As Long
Dim Status As String
Sheets("Blank").Activate
blDimensioned = False
Result = IsUSZipCode(Sheets("Main Page").SearchBox.Text)
If Result = "You have not entered a valid zip code" Or Result = "The zip code you have entered is too short" Or Result = "Please enter a Zip Code." Then
MsgBox (Result)
Else
If Result <> "Valid" Then
Sheets("Main Page").SearchBox.Text = Result
End If
ResultArray = CheckRecords(Sheets("Main Page").SearchBox.Text)
If ResultArray(0, 0) = "False" Then
Sheets("Main Page").Range("C23").Value = "The zip code entered is not covered"
Sheets("Main Page").Range("R14").Font.Size = 12
Sheets("Main Page").Range("R14:AE15").Font.FontStyle = "Bold"
Sheets("Main Page").Range("R14:AE15").Font.Color = vbYellow
Sheets("Main Page").Range("R14:AE15").Interior.ColorIndex = RGB(115, 188, 102)
Sheets("Main Page").Range("R14:AE15").MergeCells = True
Sheets("Main Page").Range("R14:AE15").WrapText = True
Sheets("Main Page").Range("R14:AE15").HorizontalAlignment = xlCenter
Sheets("Main Page").Range("R14:AE15").VerticalAlignment = xlCenter
Else
End If
If ResultArray(0, 0) = "True" Then
Selection.Sheets("Main Page").SearchBox.Text
Selection.Copy
Sheets("Blank").Paste
Range("B1").Select
Selection.Copy
Columns("A:A").Select
Selection.ClearContents
Sheets("Main Page").Select
Range("R1:AE100").Select
Selection.ClearContents
Range("R14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("R14:AE29").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Sheets("Main Page").Activate
End If
Sheets("Main Page").Protect ("checking zip code")
Sheets("Blank").Protect ("checking zip code")
End With
End Sub
'Function to find row of selected list box value
Function CheckRecords(FindItem) As String()
Dim StartRow As Integer
Dim EndRow As Integer
Dim CellValue As String
Dim blDimensioned As Boolean
Dim Values() As String
'Set variable values
ReDim Values(0 To 0, 0 To 0) As String
Values(0, 0) = "False"
blDimensioned = False
'value needed is two. This will avoid column headers being included in matches
StartRow = 2
EndRow = Sheets("List of Zip Codes").Cells(Rows.Count, "A").End(xlUp).Row
FindItem = Trim(Replace(LCase(FindItem), " ", ""))
Do While StartRow <= EndRow
CellValue = Trim(Replace(LCase(Sheets("List of Zip Codes").Cells(StartRow, 1).Value), " ", ""))
If CellValue = FindItem Then
If blDimensioned = True Then
ReDim Preserve Values(0 To 1, 0 To UBound(Values, 2) + 1) As String
Values(0, UBound(Values, 2)) = Sheets("List of Zip Codes").Cells(StartRow, 2).Value
Values(1, UBound(Values, 2)) = Sheets("List of Zip Codes").Cells(StartRow, 3).Value
Else
'No, so dimension it and flag it as dimensioned.
ReDim Values(0 To 1, 0 To 0) As String
Values(0, 0) = Sheets("List of Zip Codes").Cells(StartRow, 2).Value
Values(1, 0) = Sheets("List of Zip Codes").Cells(StartRow, 3).Value
blDimensioned = True
End If
End If
StartRow = StartRow + 1
Loop
CheckRecords = Values
End Function
<code>