Split an Array in VBA

[flanna]

I need to do something like this that works in VBA for Excel:

HowMany As Single
FromEnd As Single
LargeArray As Variant
NewArray As Variant
HowMany = 10
FromEnd = 5
LargeArray =(1,2,3,,,10000)
NewArray = LargeArray.split(HowMany, FromEnd)

That doesn't work in VBA.
What I want is to take a large, one dimensional array of numbers and make a new array that contains the 10 numbers that are right before the last 5 numbers in the array.
Here's an example:
LargeArray(1,2,3,4,5,6,7,8,9,,,,,,,100,101,102,103,104,105,106,107,108,109,110)
Extracting from it this new array:
NewArray(101,102,103,104,105)

 

[Rick Rothstein]

FromEnd is how many numbers from the end of the LargeArray the NewArray ends.
So with these variables: LargeArray(1,2,3,4,5,6,7,8,9,10) HowMany=3 FromEnd=2
NewArray would be (6,7,8). 3 numbers that finish 2 numbers from end of LargeArray.

Okay, assuming you will always be creating your LargeArray as a one-dimensional array, give this code a try...

[table="width: 500"]
[tr]
	[td]Sub test()
  
  Dim HowMany As Long, FromEnd As Long, Start As Long
  Dim LargeArray As Variant, NewArray As Variant
  
  HowMany = 3
  FromEnd = 2
    
  LargeArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  
  Start = UBound(LargeArray) - FromEnd - HowMany + 2
  NewArray = Application.Transpose(Application.Index(Application.Transpose(LargeArray), Evaluate("ROW(" & Start & ":" & Start + HowMany - 1 & ")"), 1))

  ' Let's see the results (joined together for display purposes)
  MsgBox Join(NewArray, ", ")
  
End Sub[/td]
[/tr]
[/table]

 

[flanna]

Okay, assuming you will always be creating your LargeArray as a one-dimensional array, give this code a try...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub test()
  
  Dim HowMany As Long, FromEnd As Long, Start As Long
  Dim LargeArray As Variant, NewArray As Variant
  
  HowMany = 3
  FromEnd = 2
    
  LargeArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  
  Start = UBound(LargeArray) - FromEnd - HowMany + 2
  NewArray = Application.Transpose(Application.Index(Application.Transpose(LargeArray), Evaluate("ROW(" & Start & ":" & Start + HowMany - 1 & ")"), 1))

  ' Let's see the results (joined together for display purposes)
  MsgBox Join(NewArray, ", ")
  
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Hmm... Tried it exactly as you wrote it but it gives a run-time error 13: Type mismatch warning

 

[Peter_SSs]

Hmm... Tried it exactly as you wrote it but it gives a run-time error 13: Type mismatch warning

I copy/pasted Rick's code & it worked fine for me as is.

I think we could save a transpose though by altering the NewArray line as follows:

<del>NewArray = Application.Transpose(Application.Index(Application.Transpose(LargeArray), Evaluate("ROW(" & Start & ":" & Start + HowMany - 1 & ")"), 1))</del>
NewArray = Application.Transpose(Application.Index(LargeArray, 1, Evaluate("ROW(" & Start & ":" & Start + HowMany - 1 & ")")))

 

[flanna]

I found a way to make the sub array by using this function:

Function SubArray(LargeArray As Variant, HowMany As Integer, FromEnd As Integer)
    Dim Start As Integer
    Dim NewArray As Variant
    Dim i As Integer

    ReDim NewArray(0)
    Start = UBound(LargeArray) - FromEnd - HowMany
    
        For i = 0 To (HowMany - 1)
            ReDim Preserve NewArray(i)
            NewArray(i) = LargeArray(Start + i)
        Next i
    
    SubArray = NewArray
End Function

It works!

 

[Peter_SSs]

It works!

Are you sure?
I ran this code with your function.

Sub Testing()
  Dim BigArray As Variant, NewArray As Variant
  
  BigArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  NewArray = SubArray(BigArray, 3, 2)
  MsgBox Join(NewArray)
End Sub

The result was "5 6 7". Shouldn't it have been "6 7 8"?

 

[LockeGarmin]

The code below will contain a function called "Slice" that will take a 1-Dimensional Array as the first parameter. When I've used Python or Javascript this type of function would take a "start" and "end" parameter instead of "HowMany" and "FromEnd".

Function Slice(Arr As Variant, ByVal StartIndex As Long, Optional EndIndex As Variant) As Variant

'Arr must be a 1-Dimensional Array. Otherwise it will cause an error: "Error 9: Subscript out of Range".


'If EndIndex is omited or not a number it will be converted to the
'upper bound of Arr so that the array is sliced all the way to the end.
'If EndIndex is a decimal number it will be rounded down and converted to a long.
'EndIndex being omited is equivalent to -1


'StartIndex and EndIndex can be negative numbers. If either of these parameters are negative
'it will slice the array starting from the end instead of from the beginning.


'If Arr has a lower bound of 1 it is the responsibility of the programmer to adjust the Index paramters accordingly.
'In the case of a lower bound of 1 Passing in '0' will cause an error, however the end of the array will still be -1
'for either index.

'If either index, positive or negative, land outside of the lower or upper bound of Arr an error will be raised: "Error 9: Subscript out of Range".



Dim ReturnArr As Variant
Dim lEndIndex As Long


Dim Index As Long
  
  'Convert Optional Parameter to a number
  If IsMissing(EndIndex) Or Not IsNumeric(EndIndex) Then
    lEndIndex = UBound(Arr)
  Else
    lEndIndex = Int(EndIndex)
  End If
  
  'Convert Negative Index to Start at the end of the array
  If StartIndex < 0 Then
    StartIndex = UBound(Arr) + StartIndex + 1
  End If
  
  'Convert Negative Index to Start at the end of the array
  If lEndIndex < 0 Then
    lEndIndex = UBound(Arr) + lEndIndex + 1
  End If


  ReDim ReturnArr(0 To lEndIndex - StartIndex)
  Index = 0
  
  Do Until StartIndex > lEndIndex
    ReturnArr(Index) = Arr(StartIndex)
    Index = Index + 1
    StartIndex = StartIndex + 1
  Loop
  
  Slice = ReturnArr
  
End Function

In your case you would want to use it like this since you are trying to get elements from the end:

NewArray = Slice(LargeArray, -15, -5)

I know the way this function is implemented isn't exactly what the OP asked for but it was a lot of fun to create and I'm hoping it can help someone else. I'll be keeping in my library of functions so if someone can find a bug I'd love to hear it! Below are the tests I ran with the results commented beside:

Sub TestSlice()

Dim Arr As Variant


  Arr = Array("A", "B", "C", "D", "E") 'Arr(0 to 4)
  
  Debug.Print Join(Slice(Arr, 0)) 'A B C D E
  Debug.Print Join(Slice(Arr, 1)) 'B C D E
  Debug.Print Join(Slice(Arr, 4)) 'E


  Debug.Print Join(Slice(Arr, 1, -2)) 'B C D
  Debug.Print Join(Slice(Arr, 1, -3)) 'B C
  
  Debug.Print Join(Slice(Arr, -4, -1)) 'B C D E
  Debug.Print Join(Slice(Arr, -2, -1)) 'D E
  Debug.Print Join(Slice(Arr, -5)) 'A B C D E
  
  'Start the lower bound at 1 instead of 0.
  Arr = Excel.WorksheetFunction.Transpose(Excel.WorksheetFunction.Transpose(Arr)) 'Arr(1 to 5)
  
  Debug.Print Join(Slice(Arr, 1)) 'A B C D E
  Debug.Print Join(Slice(Arr, 4)) 'D E


  Debug.Print Join(Slice(Arr, 1, -2)) 'A B C D
  Debug.Print Join(Slice(Arr, 1, -3)) 'A B C


  On Error Resume Next
  Debug.Print Join(Slice(Arr, 0)) 'ERROR! (Error 9, Subscript out of Range) The LBound now starts at 1 instead of 0
  
  Arr = Array("A", "B", "C", "D", "E") 'Arr(0 to 4)


  Debug.Print Join(Slice(Arr, 5)) 'ERROR! (Error 9, Subscript out of Range)
  Debug.Print Join(Slice(Arr, 0, 6)) 'ERROR! (Error 9, Subscript out of Range)


  Debug.Print Join(Slice(Arr, -6)) 'ERROR! (Error 9, Subscript out of Range)
  
End Sub

 

[flanna]

Are you sure?
I ran this code with your function.

Sub Testing()
  Dim BigArray As Variant, NewArray As Variant
  
  BigArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  NewArray = SubArray(BigArray, 3, 2)
  MsgBox Join(NewArray)
End Sub

The result was "5 6 7". Shouldn't it have been "6 7 8"?

Thanks Peter_SSs, you are right. I needed to add 1 to the Start variable. Now it does just what I wanted.