Subscript Out Of Range (Error 9) on ReDim in VBA

Question

I am getting an error when trying to create a new Member in my "Shifts" class. This sub is meant to fill the following variables (which are declared at the top of the class):

Private ShiftMembers() As String
Private ShiftCallSigns() As String
Private ShiftAssignments() As String
Private ShiftStatuses() As String

Public Sub AddMember(ByVal Name As String, ByVal CallSign As String, ByVal Assignment As String, Optional ByVal Status As String)
  If IsEmpty(ShiftMembers) = False Then
    ReDim Preserve ShiftMembers(UBound(ShiftMembers) + 1)
    ReDim Preserve ShiftCallSigns(UBound(ShiftCallSigns) + 1)
    ReDim Preserve ShiftAssignments(UBound(ShiftAssignments) + 1)
    ReDim Preserve ShiftStatuses(UBound(ShiftStatuses) + 1)

  Else
    ReDim Preserve ShiftMembers(0)
    ReDim Preserve ShiftCallSigns(0)
    ReDim Preserve ShiftAssignments(0)
    ReDim Preserve ShiftStatuses(0)
  End If


  ShiftMembers(UBound(ShiftMembers)) = Name
  ShiftCallSigns(UBound(ShiftCallSigns)) = CallSign
  ShiftAssignments(UBound(ShiftAssignments)) = Assignment
  ShiftStatuses(UBound(ShiftStatuses)) = Status
End Sub

When I call this Sub, I get a "Subscript Out Of Range (Error 9)" message. Any ideas? Thanks! I created the "IsEmpty()" check because I believe UBound will throw an error if the array has 0 elements (right?).

Thanks in advance!

-Rob

even if no data is inside the variables (in this case arrays), if the variable is created, isempty will answer false — Patrick Lepelletier

Jason Faulkner Jason Faulkner · Accepted Answer · 2015-01-30T03:48:24

The problem is these lines:

ReDim Preserve ShiftMembers(UBound(ShiftMembers) + 1)
ReDim Preserve ShiftCallSigns(UBound(ShiftCallSigns) + 1)
ReDim Preserve ShiftAssignments(UBound(ShiftAssignments) + 1)
ReDim Preserve ShiftStatuses(UBound(ShiftStatuses) + 1)

Are accessed when no bounds are defined, so UBound throws the error. IsEmtpy will not check array bounds and if you explicitly declare the bounds at 0 then you will not be able to ReDim.

To get around this, you can keep track of your initialization separately:

Private ShiftMembers() As String
Private ShiftCallSigns() As String
Private ShiftAssignments() As String
Private ShiftStatuses() As String
Private IsInitialized As Boolean

Public Sub AddMember(ByVal Name As String, ByVal CallSign As String, ByVal Assignment As String, Optional ByVal Status As String)
  If IsInitialized Then
    ReDim Preserve ShiftMembers(UBound(ShiftMembers) + 1)
    ReDim Preserve ShiftCallSigns(UBound(ShiftCallSigns) + 1)
    ReDim Preserve ShiftAssignments(UBound(ShiftAssignments) + 1)
    ReDim Preserve ShiftStatuses(UBound(ShiftStatuses) + 1)

  Else
    ' Preserve isn't really needed here.
    ReDim Preserve ShiftMembers(0)
    ReDim Preserve ShiftCallSigns(0)
    ReDim Preserve ShiftAssignments(0)
    ReDim Preserve ShiftStatuses(0)
    IsInitialized = True
  End If


  ShiftMembers(UBound(ShiftMembers)) = Name
  ShiftCallSigns(UBound(ShiftCallSigns)) = CallSign
  ShiftAssignments(UBound(ShiftAssignments)) = Assignment
  ShiftStatuses(UBound(ShiftStatuses)) = Status
End Sub

In the above, I used an IsInitialized variable (which defaults to False) and then explicitly set it True once the array bounds are first defined.

Subscript Out Of Range (Error 9) on ReDim in VBA

2 Answers