Some useful function to manage Arrays in Excel

  This page is dedicated to provide examples of functions written in VBA for Array's management in Excel :

• A function to store the content of an array in a string...(code)
• A function to reverse the order of the elements of a given array...(code)
• A function to sort the elements of an array.(code)
• A function telling if a given item is at least once in an given array...(code)
• A function to transform an string in an array...(code)
• A function enabling swaping two elements in two given positions...(code)
• A function for concatenating two arrays...(code)
• A sub array function to extract elements from a given array comprised between 2 indexes...(code)
• A function to apply a lag on the elements of an array...(code)

Don't hesitate to send your comments/suggestions/requests by mail via contact(@)realce.net.

Thank you !

A function which returns the elements of an array in a string variable. This function can be used to show the content of an array.

' ***************************************************
Function array_show(v)
'Desc: stores the content of array v in a string of Array(x1,...,x2)
'Copyright Realce.net 22
' ***************************************************
Function array_show(v)
On Error GoTo emng_array_show
    Dim i As Integer
    If isArray(v) Then
    Dim res As Variant
    res = "Array("
    For i =LBound(v) To UBound(v)
        If (i = 0) Then
            res = res & v(0)
        Else
            res = res & "," & v(i)
        End If
    Next i
    res = res + ")"
    array_show = res
    Exit Function
    Else
    MsgBox "Error : Not an array ", vbOKOnly + vbExclamation, "Error array_show function"
    Exit Function
    End If
emng_array_show:
    MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_show function"
    Exit Function
End Function

Test code n°1 :

Sub test_array_show()
    Dim e As Variant
    e = Array(3, 6, 7, 4, 4, 1, 2)
    MsgBox array_show(array_show(e))
End Sub

The above code will produce the display of a message box containing the following text :

 
Array(3, 6, 7, 4, 4, 1, 2)

' ***************************************************
' Procedure : array_invert
' Description : Inverts the order of the elements of the input array v
' Parameters 1 
'   v : the array
'  
'  Copyright Realce.net  version:0.01
' ***************************************************
Function array_invert(v As Variant)
On Error GoTo emng_array_invert
    If VarType(v) = vbArray + vbVariant Then
        Dim g As Variant
        Dim i As Integer
        ReDim g(UBound(v)-LBound(v))
        For i = 0 To UBound(v)
            g(i) = v(UBound(v) - i)
        Next i
        array_invert = g
        Exit Function
     Else
        MsgBox "Error : Not an array ", vbOKOnly + vbExclamation, "Error array_invert function"
        Exit Function
    End If
emng_array_invert:
    MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_invert function"
    Exit Function
 End Function

Test code n°1 :

	
Sub test_array_invert()
    Dim e As Variant
    e = Array(3, 6, 7, 4, 4, 1, 2)
    MsgBox array_show(array_invert(e))
End Sub

The above code will produce the display of a message box containing the following text :

Array(2,1,4,4,7,6,3)

' ***************************************************
' Procedure : array_concat
' Description : Inverts the order of the elements of the input array v
' Parameters 2 
'   v : the array
'   w : the other array
'  
'  Copyright Realce.net 2012 version:0.01
' ***************************************************
function array_concat(v, w)
On Error GoTo emng_array_concat
    If isArray(v) And isArray(w) Then
        Dim g As Variant
        Dim a As Integer
        Dim i As Integer
        ReDim g(UBound(v) - LBound(v) + UBound(w) - LBound(w) + 1)
        a = UBound(v) - LBound(v) + 1
         For i = LBound(v) To UBound(v)
        g(i) = v(i)
        Next i
        For i = LBound(w) To UBound(w)
        g(a + i) = w(i)
       Next i
        array_concat = g
        Exit Function
    Else
        MsgBox "Error : non array detected ", vbOKOnly + vbExclamation, "Error array_concat function"
        Exit Function
    End If
emng_array_concat:
    MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_concat function"
    Exit Function
End Function

Test code n°1 :

	
Sub test_array_concat()
   Dim a As Variant
   Dim b As Variant
   Dim f As Variant
   a = Array(1, 2, 3, 4)
  b = Array(5, 6, 7)
    'Concatenation of the 2 arrays into array f 
    f = array_concat(a, b)
    MsgBox array_show(f)
End Sub

  The above code will produce the display of a message box containing the following text :

Array(1,2,3,4,5,6,7)

Thanks to the invert array function, it's possible to enhance the sort function in order to allow not only ascending but also descending order.

To do so, we add a parameter, a flag fl_asc allowing to sort in ascending order in case it's set to True, in descending order if set to false. In this case we use the array_invert function before returning the resulting array to obtain the desired sorting(code lines 021-026).

' ***************************************************
' Procedure : array_sort
' Description : Inverts the order of the elements of the input array v
' Parameters 2 
'   v : the array
'  fl_asc :ascending True/False
'  
'  Copyright Realce.net 2012 version:0.01
' ***************************************************
Function array_sort(v, fl_asc)
On Error GoTo emng_array_sort
If isArray(v) Then
    Dim cnt As Boolean
    cnt = True
    If (UBound(v) > 1) Then
        Do While (cnt = True)
            cnt = False
            For i = LBound(v) To UBound(v) - 1
                If (v(i) > v(i + 1)) Then
                    tmp = v(i)
                    v(i) = v(i + 1)
                    v(i + 1) = tmp
                    cnt = True
                End If
            Next i
        Loop
    End If
    If (fl_asc = True) Then
        array_sort = v
    Else
        array_sort = array_invert(v)
    End If
Exit Function
Else
    MsgBox "Error : Not an array ", vbOKOnly + vbExclamation, "Error array_sort function"
    Exit Function
End If
emng_array_sort:
    MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_sort function"
    Exit Function
End Function

Test code n°1 :

	
Sub test_array_sort()
    Dim e As Variant
    e = Array(3, 6, 7, 4, 4, 1, 2)
    MsgBox array_show(array_sort(e, True))
End Sub

The above code will produce the display of a message box containing the following text :

	
Array(1,2,3,4,4,6,7)

Test code n°2 :

	
Sub test_array_sort()
    Dim e As Variant
    e = Array(3, 6, 7, 4, 4, 1, 2)
    MsgBox array_show(array_sort(e, False))
End Sub

The above code will produce the display of a message box containing the following text :

	
Array(7,6,4,4,3,2,1)

' ***************************************************
' Function array_swap(v,p1,p2)
' Object : swap p1 and p2 elements from v array
' Paramters :3 
' v : array
' p1 : position 1
' p2 : position 2
' version:0.01
'***************************************************
Function array_swap(v, p1, p2) As Variant
On Error GoTo emng_array_swap
    If isArray(v) Then
        If ((p1 -1<= UBound(v)) Or (p2-1 <= UBound(v))) Then
            Dim g As Variant
            ReDim g(UBound(v) - LBound(v))
            g = v
            g(p1-1) = v(p2-1)
            g(p2-1) = v(p1-1)
            array_swap = g
            Exit Function
        Else
            MsgBox "Error : positions out of array limits ", vbOKOnly + vbExclamation, "Error array_swap function"
            Exit Function
        End If
    Else
        MsgBox "Error : Not an array ", vbOKOnly + vbExclamation, "Error array_swap function"
        Exit Function
    End If
emng_array_swap:
    MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_swap function"
    Exit Function
End Function

Test code n°1 :

Sub test_array_swap()
    Dim e As Variant
    Dim f As Variant
    e = Array(3, 6, 7, 4, 4, 1, 2)
    'We swap elements 4 and 6 of the array
    f = array_swap(e, 6, 4)
    MsgBox array_show(f)
End Sub

  The above code will produce the display of a message box containing the following text :

Array(3, 6, 7, 1, 4, 4, 2)

' ***************************************************
' Procedure : array_String2Array
' Description : Convert string s into an array prefixed by adl
' Parameters 3 
'   st : the string
'   adl : the prefix of the array in string
'   sep : separator used in the string
'   betag : begin/end tag boolean flag
'  
'  Copyright Realce.net 2012 version:0.01
' ***************************************************
Function String2Array(st, adl, sep, betag) As Variant
On Error GoTo emng_String2Array
    If isArray(v) Then
        Dim str As String
        Dim res As Variant
        str = Right(st, Len(st) - Len(adl))
        If (betag = True) Then
            res = Split(Mid(str, 2, Len(str) - 2), ",")
        Else
            res = Split(str, ",")
        End If
        String2Array = Array(UBound(res) - LBound(res))
        String2Array = res
        Exit Function
    Else
        MsgBox "Error : Not an array ", vbOKOnly + vbExclamation, "Error String2Array function"
        Exit Function
    End If
emng_String2Array:
    MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error String2Array function"
    Exit Function
End Function

Test code n°1 :

Sub test_String2Array()
    Dim e As String
    e = "Array(3, 6, 7, 4, 4, 1, 2)"
    MsgBox array_show(String2Array(e, "Array", ",", True))
End Sub

   L'exécution du code ci dessus provoque l'affichage d'une boîte de dialogue avec le texte suivant :

	
Array(3, 6, 7, 4, 4, 1, 2)

 

This function returns True if the element is found in the array v.

' ***************************************************
Function isInArray(el,v)
'Desc: returns True if value el is included in array v
'Copyright Realce.net 22
' ****
Function isInArray(el As Variant, v As Variant) As Boolean
'Desc: Check if element el is in input array v
'Copyright Realce.net 2012
On Error GoTo emng_isInArray
    Dim bRes As Boolean
    bRes = False
    Dim i As Integer
    If isArray(v)  Then
        For i = LBound(v) To UBound(v)
            If (v(i) = el) Then
                bRes = True
                Exit For
            End If
        Next i
        isInArray = bRes
        Exit Function
    Else
    MsgBox "Error : Not an array ", vbOKOnly + vbExclamation, "Error isInArray function"
    Exit Function
    End If
emng_isInArray:
    MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_show function"
    Exit Function
End Function

Code de test n°1 :

001 : 	Sub test_isInArray()
002 : 	    Dim e As Variant
003 : 	    e = Array(3, 6, 7, 4, 4, 1, 2)
004 : 	    MsgBox isInArray(7, e)
005 : 	End Sub

L'exécution du code ci dessus provoque l'affichage d'une boîte de dialogue avec le texte suivant :

Vrai

   Extract from array v elements from position sp to position ep and store it into another array.

 

' ***************************************************
' Procedure : array_subarray
' Description : extract subarray from array v between indexes sp and ep
' Parameters 3 
'   v : the array
'   sp : the start position index
'   ep : the end position index
'  
'  Copyright Realce.net  version:0.01
' ***************************************************

Function array_subarray(v, sp, ep)
On Error GoTo emng_array_subarray
    If isArray(v) Then
        If sp - 1 <= UBound(v) And ep - 1 <= UBound(v) Or ep < sp Then
            Dim g As Variant
            Dim i As Integer
            ReDim g(ep - sp)
            For i = 1 To ep - sp + 1
                g(i - 1) = v(sp + i - 2)
            Next i
            array_subarray = g
            Exit Function
        Else
            MsgBox "Error : parameters out of the limits ", vbOKOnly + vbExclamation, "Error array_subarray function"
            Exit Function
        End If
    Else
        MsgBox "Error : not an array ", vbOKOnly + vbExclamation, "Error array_subarray function"
        Exit Function
End If
    
emng_array_subarray:
     MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_subarray function"
    Exit Function
End Function

Test code n°1 :

Sub test_array_subarray()
    Dim a As Variant
    Dim b As Variant
    Dim f As Variant
    a = Array(1, 2, 3, 4, 5, 6, 7)
    'On échange les éléments 4 et 6 du tableau
    f = array_subarray(a, 3, 5)
    MsgBox array_show(f)

  The above code will produce the display of a message box containing the following text :

Array(3,4,5)

  This function applies a shift of the element i of l ranks. The shifted array is returned in a array format.

' ***************************************************
' Function array_lag(v, l)
' Desc: Function performing a lag of length l
' of the elements of array v
' Copyright Realce.net 2012
'***************************************************
On Error GoTo emng_array_lag
    If isArray(v) Then
        Dim i As Integer
        Dim res As Variant
        ReDim res(UBound(v) - LBound(v))
        For i = LBound(v) To UBound(v)
            res(i) = v((i + l) Mod (UBound(v) - LBound(v)))
        Next i
        array_lag = res
        Exit Function
    Else
        MsgBox "Error : not an array ", vbOKOnly + vbExclamation, "Error array_lag function"
        Exit Function
    End If
emng_array_lag:
MsgBox "Error : " + Err.Description, vbOKOnly + vbExclamation, "Error array_lag function"
Exit Function
End Function

Test code n°1 :

	
Sub test_array_lag()
    Dim a As Variant
    Dim f As Variant
    a = Array(1, 2, 3, 4, 5, 6, 7)
    f = array_lag(a, 3)
    MsgBox array_show(f)
End Sub

  The above code will produce the display of a message box containing the following text :

Array(4,5,6,1,2,3,4)