CODEWITHSUNDEEP
arraysexcelvba
andreithegiant
andreithegiant

Reputation: 217

runtime error 9 when pushing new array elements

I have a workbook with descriptive numbered sheet names. I need to populate an array with the numbers I extract from the sheet names. I am getting a runtime error 9 subscript out of range when I try adding new array elements. There are only 111 worksheets in the workbook so I'm nowhere near overflowing the array. I've tried declaring Dim haystack (1 To 111) but that didn't work.

Dim num As Integer
Dim newEntry As String
Dim haystack() As String
Dim wsCount As Integer

wsCount = ActiveWorkbook.Worksheets.Count
For num = 1 To wsCount
    newEntry = Mid(Worksheets(num).Name, InStr(Worksheets(num).Name, "(") + 1, InStr(Worksheets(num).Name, ")") - InStr(Worksheets(num).Name, "(") - 1)
    If IsNumeric(newEntry) Then
        haystack(num) = newEntry 'this line throws an error
    End If
Next num

Upvotes: 0

Views: 84

Answers (3)

FaneDuru
FaneDuru

Reputation: 42236

Please, try this way. It uses a second variable (k) to avoid having empty array elements:

Sub fillSheetsName()
  Dim num As Long, newEntry As String, haystack() As String, wsCount As Integer, k As Long, arr

  wsCount = ActiveWorkbook.Worksheets.count
  ReDim haystack(1 To wsCount): k = 1
  For num = 1 To wsCount
    If InStr(Worksheets(num).name, "(") > 0 And InStr(Worksheets(num).name, "(") > 0 Then _
        newEntry = Split(Split(Worksheets(num).name, "(")(1), ")")(0) 'it extracts what is between parenthesis
        If IsNumeric(newEntry) Then
            haystack(k) = newEntry: k = k + 1 'to not have empty elements (for cases where newEntry is not numeric)
            newEntry = ""
        End If
  Next num
  ReDim Preserve haystack(1 To k - 1)
  Debug.Print UBound(haystack)       'how many such numbers have been extracted
  Debug.Print Join(haystack, vbCrLf) 'see in Immediate Window the array content
End Sub

Upvotes: 1

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60174

I try to avoid redim preserve because of the overhead.

Also note that I use ThisWorkbook instead of ActiveWorkbook to avoid confusing the macro in case you have more than one workbook open.

I suggest:

Option Explicit

Sub marine()
Dim num As Integer
Dim newEntry As String
Dim haystack() As String

ReDim haystack(1 To ThisWorkbook.Worksheets.Count)
For num = 1 To UBound(haystack)
    newEntry = Mid(Worksheets(num).Name, InStr(Worksheets(num).Name, "(") + 1, InStr(Worksheets(num).Name, ")") - InStr(Worksheets(num).Name, "(") - 1)
    If IsNumeric(newEntry) Then
        haystack(num) = newEntry
    End If
Next num
End Sub

If you don't mind having haystack typed as a variant (the contents will still be strings), but you don't want to have empty entries, you can use the ArrayList object, which has a simple method of copying to a variant array.

You could also use a Collection or Dictionary object, but the code would be a bit longer.

Sub merge()
Dim ws As Worksheet
Dim newEntry As String
Dim haystack() As Variant
Dim arrHaystack As Object

Set arrHaystack = CreateObject("System.Collections.ArrayList")

For Each ws In ThisWorkbook.Worksheets
    With ws
        newEntry = Mid(.Name, InStr(.Name, "(") + 1, InStr(.Name, ")") - InStr(.Name, "(") - 1)
    End With
    If IsNumeric(newEntry) Then
        arrHaystack.Add newEntry
    End If
Next ws

haystack = arrHaystack.toarray

End Sub

Upvotes: 3

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19722

Try this code:

Sub Test()

    Dim num As Integer
    Dim newEntry As String
    Dim haystack As Variant
    Dim wsCount As Integer
    
    wsCount = ActiveWorkbook.Worksheets.Count
    For num = 1 To wsCount
        newEntry = Mid(Worksheets(num).Name, InStr(Worksheets(num).Name, "(") + 1, InStr(Worksheets(num).Name, ")") - InStr(Worksheets(num).Name, "(") - 1)
        If IsNumeric(newEntry) Then
            If IsEmpty(haystack) Then
                ReDim haystack(0)
            Else
                ReDim Preserve haystack(UBound(haystack) + 1)
            End If
            haystack(num - 1) = newEntry
        End If
    Next num

End Sub

Upvotes: 0

Related Questions