Excel VBA error "subscript out of range" when calling Sub procedure if intersection in three different ranges

Question

I do not understand why I'm getting this error: "Excel VBA: subscript out of range". The code works when I delete the sections of VBA code "Group 2" and "Group 1".

Also, is there a better way to write this code to get full state names from abbreviations? The code should automatically update the cell value in the table column range to the full name for the state each time an abbreviation for the state is entered.

In a Sheet:

Public Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, DataSheet.ListObjects("Group3").ListColumns("State").DataBodyRange.Rows) Is Nothing Then
StateFullName Target
End If

If Not Application.Intersect(Target, DataSheet.ListObjects("Group2").ListColumns("State").DataBodyRange.Rows) Is Nothing Then
StateFullName Target
End If

If Not Application.Intersect(Target, DataSheet.ListObjects("Group1").ListColumns("State").DataBodyRange.Rows) Is Nothing Then
StateFullName Target
End If

End Sub

In a Module:

Sub StateFullName(ByVal Target As Range)
On Error GoTo eh
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Target.Value = Replace(Target.Value, "AL", "Alabama")
Target.Value = Replace(Target.Value, "AK", "Alaska")
Target.Value = Replace(Target.Value, "AZ", "Arizona")
Target.Value = Replace(Target.Value, "AR", "Arkansas")
Target.Value = Replace(Target.Value, "AS", "American Samoa")
Target.Value = Replace(Target.Value, "CA", "California")
Target.Value = Replace(Target.Value, "CO", "Colorado")
Target.Value = Replace(Target.Value, "CT", "Connecticut")
Target.Value = Replace(Target.Value, "DE", "Delaware")
Target.Value = Replace(Target.Value, "DC", "District of Columbia")
Target.Value = Replace(Target.Value, "FL", "Florida")
Target.Value = Replace(Target.Value, "GA", "Georgia")
Target.Value = Replace(Target.Value, "GU", "Guam")
Target.Value = Replace(Target.Value, "HI", "Hawaii")
Target.Value = Replace(Target.Value, "ID", "Idaho")
Target.Value = Replace(Target.Value, "IL", "Illinois")
Target.Value = Replace(Target.Value, "IN", "Indiana")
Target.Value = Replace(Target.Value, "IA", "Iowa")
Target.Value = Replace(Target.Value, "KS", "Kansas")
Target.Value = Replace(Target.Value, "KY", "Kentucky")
Target.Value = Replace(Target.Value, "LA", "Louisiana")
Target.Value = Replace(Target.Value, "ME", "Maine")
Target.Value = Replace(Target.Value, "MD", "Maryland")
Target.Value = Replace(Target.Value, "MA", "Massachusetts")
Target.Value = Replace(Target.Value, "MI", "Michigan")
Target.Value = Replace(Target.Value, "MN", "Minnesota")
Target.Value = Replace(Target.Value, "MS", "Mississippi")
Target.Value = Replace(Target.Value, "MO", "Missouri")
Target.Value = Replace(Target.Value, "MT", "Montana")
Target.Value = Replace(Target.Value, "NE", "Nebraska")
Target.Value = Replace(Target.Value, "NV", "Nevada")
Target.Value = Replace(Target.Value, "NH", "New Hampshire")
Target.Value = Replace(Target.Value, "NJ", "New Jersey")
Target.Value = Replace(Target.Value, "NM", "New Mexico")
Target.Value = Replace(Target.Value, "NY", "New York")
Target.Value = Replace(Target.Value, "NC", "North Carolina")
Target.Value = Replace(Target.Value, "ND", "North Dakota")
Target.Value = Replace(Target.Value, "MP", "Northern Mariana Islands")
Target.Value = Replace(Target.Value, "OH", "Ohio")
Target.Value = Replace(Target.Value, "OK", "Oklahoma")
Target.Value = Replace(Target.Value, "OR", "Oregon")
Target.Value = Replace(Target.Value, "PA", "Pennsylvania")
Target.Value = Replace(Target.Value, "PR", "Puerto Rico")
Target.Value = Replace(Target.Value, "RI", "Rhode Island")
Target.Value = Replace(Target.Value, "SC", "South Carolina")
Target.Value = Replace(Target.Value, "SD", "South Dakota")
Target.Value = Replace(Target.Value, "TN", "Tennessee")
Target.Value = Replace(Target.Value, "TX", "Texas")
Target.Value = Replace(Target.Value, "TT", "Trust Territories")
Target.Value = Replace(Target.Value, "UT", "Utah")
Target.Value = Replace(Target.Value, "VT", "Vermont")
Target.Value = Replace(Target.Value, "VA", "Virginia")
Target.Value = Replace(Target.Value, "VI", "Virgin Islands")
Target.Value = Replace(Target.Value, "WA", "Washington")
Target.Value = Replace(Target.Value, "WV", "West Virginia")
Target.Value = Replace(Target.Value, "WI", "Wisconsin")
Target.Value = Replace(Target.Value, "WY", "Wyoming")
Target.Value = Application.WorksheetFunction.Trim(Target.Value)
Application.EnableEvents = True
eh: Application.EnableEvents = True
End Sub

Mathieu Guindon · Accepted Answer · 2023-01-22 23:48:09Z

4

Make sure you have a table that's named after each one of the 3 groups (including the presence or absence of spaces!); in VBA a "subscript" is the part between parentheses in an array index access, but often the same "subscript out of range" error is recycled when trying to retrieve an item from a keyed object collection, like ListObjects or Worksheets (mostly because the Variant argument to the Item default property involved in these cases can be either a numeric index or a string name).

This is a good use case for a static dictionary lookup - define the dictionary in a StateCodes standard module:

Option Explicit
Private Lookup As Scripting.Dictionary 'early-bound requires reference to Scripting runtime library; use 'As Object' if late-bound.

Private Sub InitializeLookup()
    If Not Lookup Is Nothing Then Exit Sub
    Set Lookup = New Scripting.Dictionary 'late-bound: = CreateObject("Scripting.Dictionary")
    With Lookup
        .Add "AL", "Alabama"
        .Add "AK", "Alaska"
        .Add "AZ", "Arizona"
        '...
        .Add "WY", "Whyoming"
    End With
End Sub

Now all that's left to do is to write a small helper function (in the same module) to perform the lookup:

'@Description "Gets the full name for the specified state code; returns True if the lookup succeeds, False otherwise."
Public Function TryGetNameFor(ByVal Code As String, ByRef outResult) As Boolean
    InitializeLookup
    If Lookup.Exists(Code) Then
        outResult = Lookup(Code)
        GetNameFor = True
    Else
        outResult = Code
        GetNameFor = False
    End If
End Function

Now the SetStateFullName(ByVal Target As Range) macro (note the verb at the beginning of the name!) can look like this:

Public Sub SetStateFullName(ByVal Target As Range)
    On Error GoTo CleanFail

    Dim FullName As String
    If StateCodes.TryGetNameFor(Target.Value, outResult:=FullName) Then
        Application.EnableEvents = False
        Target.Value = Replace(Target.Value, FullName)
    End If

CleanExit:
    'code here runs only once, regardless of whether there was an error or not
    Application.EnableEvents = True
    Exit Sub

CleanFail:
    'handle error here
    Resume CleanExit ' don't leave the scope in an error-handling state
End Sub

Note that I stuck with the VBA.String.Replace function, but Range.Replace might also have been used here.

answered Jan 22, 2023 at 23:48

Mathieu Guindon

71.5k8 gold badges113 silver badges250 bronze badges

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

3 Comments

VBasic2008 Over a year ago

Brilliant and educational, as always. When I open (reference) a workbook Set wb =..., do something, and close it with wb.Close False, the state of the variable stays Not wb Is Nothing. I don't know what such a case is called (it runs out of scope?) but my point is, could this happen to the Lookup variable in your presented case?

Mathieu Guindon Over a year ago

@VBasic2008 thanks! in that case the workbook reference is set, but the underlying pointer is pointing to an object that no longer exists, kind of like when you reference a Range and then delete it: the reference is there, but invalid. This can happen whenever you reference objects that you don't own (Excel owns workbooks and ranges and everything in its object model), but the Lookup dictionary only ever lives in the VBA runtime context, so no.

QHarr Over a year ago

I think editing blip - your function should be using TryGetNameFor = for return

Collectives™ on Stack Overflow

Excel VBA error "subscript out of range" when calling Sub procedure if intersection in three different ranges

1 Answer 1

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related