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

simply replace InStr(1, cel.Value, ZipA()) with IsNumeric(Application.Match(cel.Value, ZipA(),0)) and it will work (same goes for the other cities). But it would be faster if all zip codes are in a 2d table with the respective cities, this way you could do it like you would with formulas: cel.Offset(0, 6).Value = Sheets("MyZips").Cells(Application.Match(cel.Value,Sheets("MyZips").Columns(1), 0), 2) ;) — Dirk Reichel
– Dirk Reichel, Commented May 15, 2016 at 8:21

Scott Craner · Accepted Answer · 2016-05-19 21:03:24Z

4

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

edited May 19, 2016 at 21:03

answered May 15, 2016 at 4:20

Scott Craner

153k10 gold badges52 silver badges88 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Kaelen Over a year ago

I'm not sure what happened but this unfortunately did not work. It threw the city value in cells that it shouldn't have.. lots of them. I may not have executed correctly. Please see my comments on user3598756's post above for further clarification on my issue - I don't think I explained it in great enough detail initially.

Kaelen Over a year ago

It worked! Thanks a ton, this will really help me in the future! I wasn't aware that you could nest one For Each loop within another. Though it may not be the most efficient method, I think I'll stick to it until I learn a little more. Much appreciated, friend.

user3598756 · Accepted Answer · 2016-05-15 14:36:17Z

2

if you don't need arrays for other reasons then simply use strings:

   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 = "12345 12346 12347 12348 12349"
    ZipB = "22345 22346 22347 22348 22349"
    ZipC = "32345 32346 32347 32348 32349"
    ZipD = "42345 42346 42347 42348 42349"

    Set SrchRng = Range("D6:D350")

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

which is also easier to write

should the numeric "rule" I could extrapolate out of your example actually apply you could also go like follows:

Option Explicit

Sub LabelCell()
    Dim SrchRng As Range, cel As Range

    Set SrchRng = Range("D6:D350")

    For Each cel In SrchRng
        cel.Offset(0, 6).Value = Choose(cel.Value / 10000, "City 1", "City 2", "City 3", "City 4")
    Next cel
End Sub

Finally, some coding suggestions:

1) whatever method you'll use, you may want to narrow the search range down to relevant cells only like:

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlNumbers) ' consider only cells with a constant (i.e not a formula result) number value

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeFormulas, xlNumbers)' consider only cells with a "formula" (i.e.: deriving from a formula) number value

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlTextValues)' consider only cells with a constant (i.e not a formula result) string value

Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeFormulas, xlTextValues)' consider only cells with a "formula" (i.e.: deriving from a formula) string value

2) consider using Select Case syntax instead of If-Then-ElseIf-EndIf one, which will also lead to less typing

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

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

    Set SrchRng = Range("D6:D350").SpecialCells(xlCellTypeConstants, xlNumbers)

    For Each cel In SrchRng
        val = cel.Value
        Select Case True
            Case InStr(1, ZipA, val) > 0
                city = "City 1"
            Case InStr(1, ZipB, val) > 0
                city = "City 2"
            Case InStr(1, ZipC, val) > 0
                city = "City 3"
            Case InStr(1, ZipD, val) > 0
                city = "City 4"
            Case Else
                ' code to handle this situation
        End Select
        cel.Offset(0, 6).Value = city
    Next cel
End Sub

where I also adopted two more variables (val and city) to reduce typing furtherly

edited May 15, 2016 at 14:36

answered May 15, 2016 at 5:59

user3598756

29.5k4 gold badges20 silver badges30 bronze badges

3 Comments

Kaelen Over a year ago

Thanks to all who have responded. Some awesome tips in this post in particular. I've tinkered with most of the suggestions, but to no avail. I will have to set some time aside and revisit when I can focus and identify the, likely obvious, mistake I'm overlooking. Also I think I may not be explaining my methodology in great enough detail to find the proper solution. I shall return.

Kaelen Over a year ago

I can't use the string containing zip codes to search a matching substring within SrchRng cells because (from what I understand) each cell contains a full address in it - i.e: 1234 Drury Ln, Gingertown, PA 55555 If I'm not mistaken, the zip would have to be isolated in order to return true. ran out of space -- continued below

Kaelen Over a year ago

I'm really trying to identify which substring among 4 sets of substrings(ZipA,ZipB,ZipC,ZipB) exists within the full address string in each cell. That was my logic behind comparing the cell as the string to the array of zips as potential substrings (also my logic behind using an array - isolation of substring to search for)

Kaelen · Accepted Answer · 2016-05-20 09:45:45Z

The solution is simple - loopception! Thanks to Scott Craner for the answer. Here's what I did to achieve the desired result:

-Declare a new Variant, str in this case

Dim SrchRng As Range, cel As Range, str As Variant

-Nest a second For Each loop within the first that cycles through each element in the array(str as the substring search criteria) until the string being searched(cel.Value) either yields a match, or one full iteration returns 0.

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
Exit For 'etc

I'm sure there is a more complex solution that uses less memory; but, as a beginner, this worked perfectly for me. If you stumbled upon this answer while Googling a solution, I definitely recommend reading ALL the answers for some great tips & detailed explanations!

Collectives™ on Stack Overflow

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

3 Answers 3

2 Comments

3 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

2 Comments

3 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related