CODEWITHSUNDEEP
arraysexcelvbamultidimensional-arraytranspose
Spurious
Spurious

Reputation: 1995

Read out wrongly defined multidimensional array

I have an array that I gathered from a code that splits and then slices an array.

Refer to this question: Split multidimensional array and then slice it

I have added this line of code: splitted = Application.Transpose(splitted)

Now the array is defined the following way:

Array information

When I try to run the following code:

For r = LBound(splitted) To UBound(splitted)
    Debug.Print uniqueValues(splitted(r))
Next r

I get this error: run time error 9 subscript out of range

For reference with the original code, I receive this output: original code output

It works fine with my function and I can only imagine that it has to do with the difference in the definition of the array.

The function requires this input: Function uniqueValues(uniqueArray As Variant) As Integer:

Function uniqueValues(uniqueArray As Variant) As Integer
Dim arr As New Collection, a
Dim i As Long

On Error Resume Next
For Each a In uniqueArray
   arr.Add a, a
Next

uniqueValues = arr.Count

End Function

This is the code from the function that dee provided:

Sub SplitMe()
    Dim source As Variant, tempArr As Variant
    source = ActiveSheet.Range("A3:A5")

    If Not IsArray(source) Then _
        Exit Sub

    Dim r As Integer
    Dim parts() As String
    Dim splitted As Variant
    ReDim splitted(LBound(source) To UBound(source))

    For r = LBound(source) To UBound(source)
        parts = VBA.Split(source(r, 1), "\")
        splitted(r) = parts
    Next r

    splitted = Application.Transpose(splitted)
    'ReDim tempArr(LBound(splitted) To UBound(splitted))
    'tempArr = Application.Index(splitted, 0, 1)

    For r = LBound(splitted) To UBound(splitted)
        Debug.Print uniqueValues(splitted(r))
    Next r
End Sub

Upvotes: 0

Views: 41

Answers (1)

Tim Williams
Tim Williams

Reputation: 166316

Try this:

Sub SplitMe()
    Dim source As Variant, tempArr As Variant
    source = ActiveSheet.Range("A3:A5")

    If Not IsArray(source) Then _
        Exit Sub

    Dim r As Integer
    Dim parts() As String
    Dim splitted As Variant
    ReDim splitted(LBound(source) To UBound(source))

    For r = LBound(source) To UBound(source)
        parts = VBA.Split(source(r, 1), "\")
        splitted(r) = parts
    Next r

    splitted = Application.Transpose(splitted)

    For r = LBound(splitted, 1) To UBound(splitted, 1)
        Debug.Print uniqueValues(splitted, r)
    Next r
End Sub

Function uniqueValues(uniqueArray As Variant, indx As Integer) As Integer

    Dim arr As New Collection, a, s As String
    Dim i As Long

    On Error Resume Next
    For i = LBound(uniqueArray, 2) To UBound(uniqueArray, 2)
        a = uniqueArray(indx, i)
        s = s & IIf(s <> "", ", ", "") & a
        arr.Add a, a
    Next
    Debug.Print s, arr.Count
    uniqueValues = arr.Count

End Function

Upvotes: 1

Related Questions