How do I slice an array in Excel VBA? How do I slice an array in Excel VBA? vba vba

How do I slice an array in Excel VBA?


Application.WorksheetFunction.Index(array, row, column)

If you specify a zero value for row or column, then you'll get the entire column or row that is specified.

Example:

Application.WorksheetFunction.Index(array, 0, 3)

This will give you the entire 3rd column.

If you specify both row and column as non-zero, then you'll get only the specific element.There is no easy way to get a smaller slice than a complete row or column.

Limitation: There is a limit to the array size that WorksheetFunction.Index can handle if you're using a newer version of Excel. If array has more than 65,536 rows or 65,536 columns, then it throws a "Type mismatch" error. If this is an issue for you, then see this more complicated answer which is not subject to the same limitation.

Here's the function I wrote to do all my 1D and 2D slicing:

Public Function GetArraySlice2D(Sarray As Variant, Stype As String, Sindex As Integer, Sstart As Integer, Sfinish As Integer) As Variant' this function returns a slice of an array, Stype is either row or column' Sstart is beginning of slice, Sfinish is end of slice (Sfinish = 0 means entire' row or column is taken), Sindex is the row or column to be sliced' (NOTE: 1 is always the first row or first column)' an Sindex value of 0 means that the array is one dimensional 3/20/09 ljrDim vtemp() As VariantDim i As IntegerOn Err GoTo ErrHandlerSelect Case Sindex    Case 0        If Sfinish - Sstart = UBound(Sarray) - LBound(Sarray) Then            vtemp = Sarray        Else            ReDim vtemp(1 To Sfinish - Sstart + 1)            For i = 1 To Sfinish - Sstart + 1                vtemp(i) = Sarray(i + Sstart - 1)            Next i        End If    Case Else        Select Case Stype            Case "row"                If Sfinish = 0 Or (Sstart = LBound(Sarray, 2) And Sfinish = UBound(Sarray, 2)) Then                    vtemp = Application.WorksheetFunction.Index(Sarray, Sindex, 0)                Else                    ReDim vtemp(1 To Sfinish - Sstart + 1)                    For i = 1 To Sfinish - Sstart + 1                        vtemp(i) = Sarray(Sindex, i + Sstart - 1)                    Next i                End If            Case "column"                If Sfinish = 0 Or (Sstart = LBound(Sarray, 1) And Sfinish = UBound(Sarray, 1)) Then                    vtemp = Application.WorksheetFunction.Index(Sarray, 0, Sindex)                Else                    ReDim vtemp(1 To Sfinish - Sstart + 1)                    For i = 1 To Sfinish - Sstart + 1                        vtemp(i) = Sarray(i + Sstart - 1, Sindex)                    Next i                End If        End SelectEnd SelectGetArraySlice2D = vtempExit FunctionErrHandler:    Dim M As Integer    M = MsgBox("Bad Array Input", vbOKOnly, "GetArraySlice2D")End Function


Below is a fast method to slice Excel variant arrays. Most of this was put together using the info from this excellent site http://bytecomb.com/vba-reference/

Essentially the destination array is pre-built as an empty 1d or 2d variant and passed to the sub with the source array and element index to be sliced. Due to the way arrays are stored in memory it's much faster to slice a column than a row as the memory layout allows a single block to be copied.

The good thing about this is it scales well beyond the Excel row limit.

enter image description here

Option Explicit#If Win64 Then    Public Const PTR_LENGTH As Long = 8    Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long    Public Declare PtrSafe Sub Mem_Copy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)    Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)    Private Declare PtrSafe Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)#Else    Public Const PTR_LENGTH As Long = 4    Public Declare Function GetTickCount Lib "kernel32" () As Long    Public Declare Sub Mem_Copy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)    Private Declare Function VarPtrArray Lib "VBE7" Alias "VarPtr" (ByRef Var() As Any) As LongPtr    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)    Private Declare Sub FillMemory Lib "kernel32" Alias "RtlFillMemory" (Destination As Any, ByVal Length As Long, ByVal Fill As Byte)#End IfPrivate Type SAFEARRAYBOUND    cElements    As Long    lLbound      As LongEnd TypePrivate Type SAFEARRAY_VECTOR    cDims        As Integer    fFeatures    As Integer    cbElements   As Long    cLocks       As Long    pvData       As LongPtr    rgsabound(0) As SAFEARRAYBOUNDEnd TypeSub SliceColumn(ByVal idx As Long, ByRef arrayToSlice() As Variant, ByRef slicedArray As Variant)'slicedArray can be passed as a 1d or 2d array'sliceArray can also be part bound, eg  slicedArray(1 to 100) or slicedArray(10 to 100)Dim ptrToArrayVar As LongPtrDim ptrToSafeArray As LongPtrDim ptrToArrayData As LongPtrDim ptrToArrayData2 As LongPtrDim uSAFEARRAY As SAFEARRAY_VECTORDim ptrCursor As LongPtrDim cbElements As LongDim atsBound1 As LongDim elSize As Long    'determine bound1 of source array (ie row Count)    atsBound1 = UBound(arrayToSlice, 1)    'get pointer to source array Safearray    ptrToArrayVar = VarPtrArray(arrayToSlice)    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)    ptrToArrayData = uSAFEARRAY.pvData    'determine byte size of source elements    cbElements = uSAFEARRAY.cbElements    'get pointer to destination array Safearray    ptrToArrayVar = VarPtr(slicedArray) + 8 'Variant reserves first 8bytes    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)    ptrToArrayData2 = uSAFEARRAY.pvData    'determine elements size    elSize = UBound(slicedArray, 1) - LBound(slicedArray, 1) + 1    'determine start position of data in source array    ptrCursor = ptrToArrayData + (((idx - 1) * atsBound1 + LBound(slicedArray, 1) - 1) * cbElements)    'Copy source array to destination array    CopyMemory ByVal ptrToArrayData2, ByVal ptrCursor, cbElements * elSizeEnd SubSub SliceRow(ByVal idx As Long, ByRef arrayToSlice() As Variant, ByRef slicedArray As Variant)'slicedArray can be passed as a 1d or 2d array'sliceArray can also be part bound, eg  slicedArray(1 to 100) or slicedArray(10 to 100)Dim ptrToArrayVar As LongPtrDim ptrToSafeArray As LongPtrDim ptrToArrayData As LongPtrDim ptrToArrayData2 As LongPtrDim uSAFEARRAY As SAFEARRAY_VECTORDim ptrCursor As LongPtrDim cbElements As LongDim atsBound1 As LongDim i As Long    'determine bound1 of source array (ie row Count)    atsBound1 = UBound(arrayToSlice, 1)    'get pointer to source array Safearray    ptrToArrayVar = VarPtrArray(arrayToSlice)    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)    ptrToArrayData = uSAFEARRAY.pvData    'determine byte size of source elements    cbElements = uSAFEARRAY.cbElements    'get pointer to destination array Safearray    ptrToArrayVar = VarPtr(slicedArray) + 8 'Variant reserves first 8bytes    CopyMemory ptrToSafeArray, ByVal ptrToArrayVar, PTR_LENGTH    CopyMemory uSAFEARRAY, ByVal ptrToSafeArray, LenB(uSAFEARRAY)    ptrToArrayData2 = uSAFEARRAY.pvData    ptrCursor = ptrToArrayData + ((idx - 1) * cbElements)    For i = LBound(slicedArray, 1) To UBound(slicedArray, 1)        CopyMemory ByVal ptrToArrayData2, ByVal ptrCursor, cbElements        ptrCursor = ptrCursor + (cbElements * atsBound1)        ptrToArrayData2 = ptrToArrayData2 + cbElements    Next iEnd Sub

Example usage:

Sub exampleUsage()Dim sourceArr() As VariantDim destArr As VariantDim sliceIndex As Long    On Error GoTo Err:    sourceArr = Sheet1.Range("A1:D10000").Value2    sliceIndex = 2 'Slice column 2 / slice row 2    'Build target array    ReDim destArr(20 To 10000) '1D array from row 20 to 10000'    ReDim destArr(1 To 10000) '1D array from row 1 to 10000'    ReDim destArr(20 To 10000, 1 To 1) '2D array from row 20 to 10000'    ReDim destArr(1 To 10000, 1 To 1) '2D array from row 1 to 10000    'Slice Column    SliceColumn sliceIndex, sourceArr, destArr    'Slice Row    ReDim destArr(1 To 4)    SliceRow sliceIndex, sourceArr, destArrErr:    'Tidy Up See ' http://stackoverflow.com/questions/16323776/copy-an-array-reference-in-vba/16343887#16343887    FillMemory destArr, 16, 0End Sub

Timings were on an old dual core CPU using the following test

Sub timeMethods()Const trials As Long = 10Const rowsToCopy As Long = 1048576Dim rng As RangeDim Arr() As VariantDim newArr As VariantDim newArr2 As VariantDim t As Long, t1 As Long, t2 As Long, t3 As LongDim i As Long    On Error GoTo Err    'Setup Conditions 1time only    Sheet1.Cells.Clear    Sheet1.Range("A1:D1").Value = Split("A1,B1,C1,D1", ",") 'Strings'    Sheet1.Range("A1:D1").Value = Split("1,1,1,1", ",") 'Longs    Sheet1.Range("A1:D1").AutoFill Destination:=Sheet1.Range("A1:D" & rowsToCopy), Type:=xlFillDefault    'Build source data    Arr = Sheet1.Range("A1:D" & rowsToCopy).Value    Set rng = Sheet1.Range("A1:D" & rowsToCopy)    'Build target container    ReDim newArr(1 To rowsToCopy)    Debug.Print "Trials=" & trials & " Rows=" & rowsToCopy    'Range    t3 = 0    For t = 1 To trials        t1 = GetTickCount            For i = LBound(newArr, 1) To UBound(newArr, 1)                newArr(i) = rng(i, 2).Value2            Next i        t2 = GetTickCount        t3 = t3 + (t2 - t1)        Debug.Print "Range: " & t2 - t1    Next t    Debug.Print "Range Avg ms: " & t3 / trials    'Array    t3 = 0    For t = 1 To trials        t1 = GetTickCount            For i = LBound(newArr, 1) To UBound(newArr, 1)                newArr(i) = Arr(i, 2)            Next i        t2 = GetTickCount        t3 = t3 + (t2 - t1)        Debug.Print "Array: " & t2 - t1    Next t    Debug.Print "Array Avg ms: " & t3 / trials    'Index    t3 = 0    For t = 1 To trials        t1 = GetTickCount            newArr2 = WorksheetFunction.Index(rng, 0, 2) 'newArr2 2d        t2 = GetTickCount        t3 = t3 + (t2 - t1)        Debug.Print "Index: " & t2 - t1    Next t    Debug.Print "Index Avg ms: " & t3 / trials    'CopyMemBlock    t3 = 0    For t = 1 To trials        t1 = GetTickCount            SliceColumn 2, Arr, newArr        t2 = GetTickCount        t3 = t3 + (t2 - t1)        Debug.Print "CopyMem: " & t2 - t1    Next t    Debug.Print "CopyMem Avg ms: " & t3 / trialsErr:    'Tidy Up    FillMemory newArr, 16, 0End Sub


Two things, VBA doesn't support array slicing so whatever you use, you'll have to roll your own. But since this is just for Excel, you can use the build in worksheet function index for array slicing.

Sub Test()    'All example return a 1 based 2D array.    Dim myArr As Variant 'This var must be generic to work.    'Get whole range:    myArr = ActiveSheet.UsedRange    'Get just column 1:    myArr = WorksheetFunction.Index(ActiveSheet.UsedRange, 0, 1)    'Get just row 5    myArr = WorksheetFunction.Index(ActiveSheet.UsedRange, 5, 0)End Sub