VBA Using a String Array as SubString Parameter InStr Function (Excel)

Question

Long time searcher, first time asker..

Goal: - loop through a column containing addresses - assign a value (city name) to cell offset 0,6 based on which Zip Code the cell contains

Here's what I've got so far (shortened array lengths):

   Sub LabelCell()
    Dim SrchRng As Range, cel As Range
    Dim ZipA() As String
    Dim ZipB() As String
    Dim ZipC() As String
    Dim ZipD() As String

    ZipA = Array("12345", "12346", "12347", "12348", "12349")
    ZipB = Array("22345", "22346", "22347", "22348", "22349")
    ZipC = Array("32345", "32346", "32347", "32348", "32349")
    ZipD = Array("42345", "42346", "42347", "42348", "42349")

    Set SrchRng = Range("D6:D350")

    For Each cel In SrchRng
        If InStr(1, cel.Value, ZipA()) Then
            cel.Offset(0, 6).Value = "City 1"
        ElseIf InStr(1, cel.Value, ZipB()) Then
            cel.Offset(0, 6).Value = "City 2"
        ElseIf InStr(1, cel.Value, ZipC()) Then
            cel.Offset(0, 6).Value = "City 3"
        ElseIf InStr(1, cel.Value, ZipD()) Then
            cel.Offset(0, 6).Value = "City 4"
        End If
    Next cel
End Sub

As you can see, there are 4 string arrays, each containing multiple zip codes relative to its region. I've tried Declaring the Arrays as Variants and using Split to no avail. The above code gives me a Type Mismatch error and the other methods I've tried have either yielded the same or "subscript out of range"

I'm very opposed to defining each array's length and manually assigning individual positions as the total is upwards of 400 zip codes - and more importantly, the code would look hideous.

TLDR: Is it possible to achieve what the title suggests?

Thanks

Answer 1

You will need to convert the arrays to strings to use the InStr. To do so use the Join() method which will join all the parts of the array into a string:

   Sub LabelCell()
    Dim SrchRng As Range, cel As Range
    Dim ZipA()
    Dim ZipB()
    Dim ZipC()
    Dim ZipD()

    ZipA = Array("12345", "12346", "12347", "12348", "12349")
    ZipB = Array("22345", "22346", "22347", "22348", "22349")
    ZipC = Array("32345", "32346", "32347", "32348", "32349")
    ZipD = Array("42345", "42346", "42347", "42348", "42349")

    Set SrchRng = Range("D6:D350")


    For Each cel In SrchRng
        If cel.Value <> "" Then
            If InStr(1, Join(ZipA), cel.Value) Then
                cel.Offset(0, 6).Value = "City 1"
            ElseIf InStr(1, Join(ZipB), cel.Value) Then
                cel.Offset(0, 6).Value = "City 2"
            ElseIf InStr(1, Join(ZipC), cel.Value) Then
                cel.Offset(0, 6).Value = "City 3"
            ElseIf InStr(1, Join(ZipD), cel.Value) Then
                cel.Offset(0, 6).Value = "City 4"

            End If
        End If
    Next cel
End Sub

---

EDIT

As per your comments you will need to loop through each element in the arrays to determine if each part is in the cell:

Sub LabelCell()
    Dim SrchRng As Range, cel As Range, str As Variant
    Dim ZipA()
    Dim ZipB()
    Dim ZipC()
    Dim ZipD()

    ZipA = Array("12345", "12346", "12347", "12348", "12349")
    ZipB = Array("22345", "22346", "22347", "22348", "22349")
    ZipC = Array("32345", "32346", "32347", "32348", "32349")
    ZipD = Array("42345", "42346", "42347", "42348", "42349")

    Set SrchRng = Range("D6:D350")


    For Each cel In SrchRng
        If cel.Value <> "" Then
            For Each str In ZipA
                If InStr(1, cel.Value, str) Then
                    cel.Offset(0, 6).Value = "City 1"
                    Exit For
                End If
            Next str
            For Each str In ZipB
                If InStr(1, cel.Value, str) Then
                    cel.Offset(0, 6).Value = "City 2"
                    Exit For
                End If
            Next str
            For Each str In ZipC
                If InStr(1, cel.Value, str) Then
                    cel.Offset(0, 6).Value = "City 3"
                    Exit For
                End If
            Next str
            For Each str In ZipD
                If InStr(1, cel.Value, str) Then
                    cel.Offset(0, 6).Value = "City 4"
                    Exit For
                End If
            Next str

        End If
    Next cel
End Sub