Array functions

debugPrintArray

Public Sub debugPrintArray(varHaystack As Variant)
    Dim varStraw As Variant
    
    Debug.Print
    Debug.Print "debugPrintArray"
    Debug.Print "---------------"
    For Each varStraw In varHaystack
        If IsArray(varStraw) Then
            Debug.Print Join(varStraw, " | ")
        Else
            Debug.Print varStraw
        End If
    Next varStraw
End Sub

splitCamelCase

'@TODO splitCamelCase
Public Function splitCamelCase() As Variant
    MsgBox "Not yet implemented", vbInformation + vbOKOnly, "splitCamelCase"
End Function

inArray

Public Function inArray(ByVal varHaystack As Variant, ByVal varNeedle As Variant) As Boolean
    Dim blnResult As Boolean
    
    Dim varStraw As Variant
    
    blnResult = False
    
    If Not IsArray(varHaystack) Or IsEmpty(varHaystack) Then
        Exit Function
    End If
    
    For Each varStraw In varHaystack
        If varStraw = varNeedle Then
            blnResult = True
            Exit For
        End If
    Next varStraw
    
    inArray = blnResult
End Function

getArrayIndex

Public Function getArrayIndex(ByVal varHaystack As Variant, ByVal varNeedle As Variant) As Long
    Dim lngResult As Long
    
    Dim varStraw As Variant
    
    For Each varStraw In varHaystack
        If varStraw = varNeedle Then
            Exit For
        End If
        lngResult = lngResult + 1
    Next varStraw
    
    If lngResult > UBound(varHaystack) Then
        lngResult = -1
    End If
    
    getArrayIndex = lngResult
End Function

addArrayElement

Public Function addArrayElement(ByRef varHaystack As Variant, ByVal varStraw As Variant) As Variant
    Dim varResult As Variant
    
    If IsEmpty(varHaystack) Then
        'varResult = Split(varStraw, vbNullString)
         varResult = Array(varStraw)
    Else
        varResult = varHaystack
        ReDim Preserve varResult(UBound(varResult) + 1)
        varResult(UBound(varResult)) = varStraw
    End If
    
    varHaystack = varResult
    addArrayElement = varResult
End Function

removeArrayElement

Public Function removeArrayElement(ByVal varHaystack As Variant, ByVal varNeedle As Variant) As Variant
    Dim varResult As Variant
    
    Dim lngIndexNeedle As Long
    Dim lngIndex As Long
    
    If inArray(varHaystack, varNeedle) Then
    
        lngIndexNeedle = getArrayIndex(varHaystack, varNeedle)
        For lngIndex = lngIndexNeedle To UBound(varHaystack) - 1
            varHaystack(lngIndex) = varHaystack(lngIndex + 1)
        Next
        ReDim Preserve varHaystack(UBound(varHaystack) - 1)
    End If
    
    varResult = varHaystack
    
    removeArrayElement = varResult
End Function

mergeArrays

Public Function mergeArrays(ParamArray varHaystacks()) As Variant
    Dim varResult As Variant
    
    Dim varHaystack As Variant
    Dim varStraw As Variant
    
    For Each varHaystack In varHaystacks
        If Not IsEmpty(varHaystack) Then
            For Each varStraw In varHaystack
                addArrayElement varResult, varStraw
            Next varStraw
        End If
    Next varHaystack
    
    mergeArrays = varResult
End Function

integrateArray

Public Function integrateArray(varHaystack As Variant, ParamArray varHaystacks()) As Variant
    Dim varResult As Variant
    
    Dim varNeedles As Variant
    Dim varNeedle As Variant
    Dim lngIndex As Long
    
    varResult = varHaystack
    For Each varNeedles In varHaystacks
        For Each varNeedle In varNeedles
            If inArray(varResult, varNeedle) Then
                lngIndex = getArrayIndex(varResult, varNeedle)
            Else
                varResult = integrateArrayElement(varResult, varNeedle, lngIndex + 1)
            End If
        Next varNeedle
    Next varNeedles
    
    integrateArray = varResult
End Function

integrateArrayElement

Public Function integrateArrayElement(varHaystack As Variant, varNeedle As Variant, lngIndex As Long)
    Dim varResult As Variant
    
    Dim lngArrayUbound As Long
    Dim lngArrayIndex As Long
    
    varResult = varHaystack
    
    If IsEmpty(varResult) Then
        varResult = Array(varNeedle)
    Else
        ReDim Preserve varResult(UBound(varResult) + 1)
        
        'If isValidIndex(varResult, lngIndex) Then
            For lngArrayIndex = UBound(varResult) To 0 Step -1
                Select Case lngArrayIndex
                Case Is > lngIndex
                    varResult(lngArrayIndex) = varResult(lngArrayIndex - 1)
                Case lngIndex
                    varResult(lngArrayIndex) = varNeedle
                Case Is < lngIndex
                    Exit For
                End Select
            Next lngArrayIndex
        'Else
        '    Stop
        'End If
    End If
    
    integrateArrayElement = varResult
End Function

removeArray

Public Function removeArray(varHaystack As Variant, ParamArray varHaystacks()) As Variant
    Dim varResult As Variant
    
    Dim varNeedles As Variant
    Dim varNeedle As Variant
    Dim varStraw As Variant
    
    varResult = varHaystack
    For Each varNeedles In varHaystacks
        For Each varNeedle In varNeedles
            removeArrayElement varResult, varNeedle
        Next varNeedle
    Next varNeedles
    
    removeArray = varResult
End Function

getArrayWhere

Public Function getArrayWhere( _
    ByVal varHaystack As Variant, _
    ByVal varIndices As Variant, _
    ByVal varCriteria As Variant _
    ) As Variant
    Dim varResult As Variant
    
    Dim lngIndex As Long
    Dim varStraw As Variant
    Dim blnMatch As Boolean
    Dim varIndex As Variant
    
    If Not IsArray(varIndices) Then
        varIndices = Array(varIndices)
    End If

    If Not IsArray(varCriteria) Then
        varCriteria = Array(varCriteria)
    End If
        
    If UBound(varIndices) = -1 Then
        Debug.Print "### getArrayWhere: varIndices is empty"
        If isDebug Then
            Stop
        End If
        Exit Function
    End If
    
    If UBound(varCriteria) = -1 Then
        Debug.Print "### getArrayWhere: varCriteria is empty"
        If isDebug Then
            Stop
        End If
        Exit Function
    End If
    
    If UBound(varIndices) <> UBound(varCriteria) Then
        Debug.Print "### getArrayWhere: varIndices and varCriteria differ in size"
        If isDebug Then
            Stop
        End If
        Exit Function
    End If
    
    For Each varStraw In varHaystack
    
        blnMatch = True
        lngIndex = -1
        For Each varIndex In varIndices
        
            lngIndex = lngIndex + 1
            If IsArray(varStraw) Then
                If CStr(varStraw(varIndex)) <> CStr(varCriteria(lngIndex)) Then
                    blnMatch = False
                    Exit For
                End If
            Else
                If CStr(varStraw) <> CStr(varCriteria(lngIndex)) Then
                    blnMatch = False
                    Exit For
                End If
            End If
        Next varIndex
        
        If blnMatch Then
            addArrayElement varResult, varStraw
        End If
    Next varStraw
    
    getArrayWhere = varResult
End Function

getArrayField

Public Function getArrayField( _
    ByVal varHaystack As Variant, _
    ByVal intIndex As Integer, _
    Optional ByVal blnDistinct As Boolean = False _
    ) As Variant
    Dim varResult As Variant
    
    Dim varStraw As Variant
    
    If IsEmpty(varHaystack) Then
        varResult = Array()
    Else
        For Each varStraw In varHaystack
            addArrayElement varResult, varStraw(intIndex)
        Next
    End If
    
    If blnDistinct Then
        varResult = getDistinctArray(varResult)
    End If
    
    getArrayField = varResult
End Function

getDistinctArray

Public Function getDistinctArray(ByVal varHaystack As Variant) As Variant
    Dim varResult As Variant
    
    Dim varStraw As Variant
    
    If IsEmpty(varHaystack) Then
        varResult = Array()
    Else
        For Each varStraw In varHaystack
            If Not inArray(varResult, varStraw) Then
                addArrayElement varResult, varStraw
            End If
        Next
    End If
    
    getDistinctArray = varResult
End Function

transposeArray

'@TODO transposeArray
Public Function transposeArray() As Variant
    MsgBox "Not yet implemented", vbInformation + vbOKOnly, "transposeArray"
End Function

extractArray

'@TODO extractArray
Public Function extractArray()
    MsgBox "Not yet implemented", vbInformation + vbOKOnly, "extractArray"
End Function

isValidIndex

'@TODO isValidIndex
Public Function isValidIndex() As Boolean
    MsgBox "Not yet implemented", vbInformation + vbOKOnly, "isValidIndex"
End Function

assertArray

Public Function assertArray(varContent As Variant) As Variant
    Dim varResult As Variant
    
    If IsEmpty(varContent) Then
        varResult = Array()
    ElseIf Not IsArray(varContent) Then
        varResult = Array(varContent)
    Else
        varResult = varContent
    End If
    
    assertArray = varResult
End Function

dumpArray

'@TODO dumpArray
Public Sub dumpArray()
    MsgBox "Not yet implemented", vbInformation + vbOKOnly, "dumpArray"
End Sub

insertArray

Public Sub insertArray()
    MsgBox "Not yet implemented", vbInformation + vbOKOnly, "insertArray"
End Sub

splitArray

'Split all array elements by a string, put the left part in one array and the right part in another array
Public Sub splitArray(ByVal varHaystack As Variant, ByVal strSplitBy As String, ByRef varLeft As Variant, ByRef varRight As Variant)
    Dim varStraw As Variant
    Dim varLeftRight As Variant
    
    For Each varStraw In varHaystack
        varLeftRight = Split(varStraw, strSplitBy, -1, vbTextCompare)
        addArrayElement varLeft, Trim(varLeftRight(0))
        addArrayElement varRight, (varLeftRight(1))
    Next varStraw
End Sub