Excel VBA subscript out of range

Question

I am trying to take a string from each cell split it into the array and then decide how many points to add then add them and display them. However I keep coming up with a subscript out of range error I thought it had something to do with the split statement so I revised it several times and still didn't get any where. I also then thought maybe it wasn't the split and maybe there was nothing in that cell but with the (ElseIf array = "" Then) should have taken care of that. Here's my code:

Sub pointsAdd()

'Init Variables
Dim pointArray() As String
Dim j As Integer
Dim i As Integer
Dim points As Integer

'Make sure the correct sheet is selected
Worksheets("Sheet1").Activate

'Add Points Up
For j = 2 To 100
  Cells(j, 1).Select
  If ActiveCell.Value = "" Then
    j = 100
  Else
    For i = 3 To 22
      Cells(j, i).Select
      pointArray = Split(ActiveCell.Value, ".")

'The next line is where the debugger says the script is out of range
      If pointArray(0) = "Tardy" Then     
        points = 0.5
      ElseIf pointArray(0) = "Failure To Complete Shift" Then
        points = 0.5
      ElseIf pointArray(0) = "Failure To Complete At Least Half Shift" Then
        points = 0.5
      ElseIf pointArray(0) = "Absence" Then
        points = 1
      ElseIf pointArray(0) = "Late Call Off" Then
        points = 2
      ElseIf pointArray(0) = "No Call/No Show" Then
        points = 4
      ElseIf pointArray(0) = "" Then
        i = i + 1
      Else
        MsgBox "Somthing is wrong in Module 1 Points Adding"
      End If

      'Add points to points cell
      Cells(j, 2).Select
      points = points + ActiveCell.Value
      ActiveCell.Value = points
    Next i
  End If
Next j

End Sub

Also the format of the string that should be in the cell is "Occurrence.Description.Person.mm/dd/yyyy".

Answer 1

You could try this approach, which includes a little tidying up by removing select statements.

Sub pointsAdd()

'Init Variables
Dim pointArray() As String
Dim j As Integer
Dim i As Integer
Dim points As Integer

'Make sure the correct sheet is selected
Worksheets("Sheet1").Activate

'Add Points Up
For j = 2 To 100
    If Cells(j, 1).Value = "" Then
        exit for
    Else
        For i = 3 To 22
            pointArray = Split(Cells(j, i).Value, ".", -1)

            'The next line is where the debugger says the script is out of range
            If UBound(pointArray) > -1 Then
                If pointArray(0) = "Tardy" Then
                    points = 0.5
                ElseIf pointArray(0) = "Failure To Complete Shift" Then
                    points = 0.5
                ElseIf pointArray(0) = "Failure To Complete At Least Half Shift" Then
                    points = 0.5
                ElseIf pointArray(0) = "Absence" Then
                    points = 1
                ElseIf pointArray(0) = "Late Call Off" Then
                    points = 2
                ElseIf pointArray(0) = "No Call/No Show" Then
                    points = 4
                ElseIf pointArray(0) = "" Then
                    i = i + 1
                Else
                    MsgBox "Somthing is wrong in Module 1 Points Adding"
                End If
            End If
            'Add points to points cell
            points = points + Cells(j, 2).Value
            Cells(j, 2).Value = points
        Next i
    End If
Next j

End Sub

Answer 2

You are getting a subscript out of range error whenever your inner for loop gets an empty cell. The following code is a working version of your code above:

Sub pointsAdd()

'Init Variables
Dim pointArray() As String
Dim j As Integer
Dim i As Integer
Dim points As Integer

'Make sure the correct sheet is selected
Worksheets("Sheet1").Activate

'Add Points Up
For j = 2 To 100

    Cells(j, 1).Select

    If ActiveCell.Value = "" Then
        j = 100
    Else
        For i = 3 To 22

            Cells(j, i).Select

            Dim Val As String
            Val = ActiveCell.Value

            ' Check if cell value is not empty
            If (Val <> "") Then
                pointArray = Split(ActiveCell.Value, ".", -1)

                'The next line is where the debugger says the script is out of range
                If pointArray(0) = "Tardy" Then
                    points = 0.5
                    ElseIf pointArray(0) = "Failure To Complete Shift" Then
                    points = 0.5
                    ElseIf pointArray(0) = "Failure To Complete At Least Half Shift" Then
                    points = 0.5
                    ElseIf pointArray(0) = "Absence" Then
                    points = 1
                    ElseIf pointArray(0) = "Late Call Off" Then
                    points = 2
                    ElseIf pointArray(0) = "No Call/No Show" Then
                    points = 4
                    ElseIf pointArray(0) = "" Then
                    i = i + 1
                    Else
                    ' MsgBox "Somthing is wrong in Module 1 Points Adding"

                End If

                'Add points to points cell
                Cells(j, 2).Select
                points = points + ActiveCell.Value
                ActiveCell.Value = points

            Else

                ' A cell was found empty
                i = 23
            End If


        Next i

    End If
Next j

End Sub

Note: It stops to look further when it finds any empty cell in a row. It continues to the next row in that case.