DeflateArray Function

Function DeflateArray(arrDeflate As Variant) As Variant

The DeflateArray function's return value is a variant array. This array will contain the elements of arrDeflate minus duplicate elements. You must assign the return to a variant variable.

Function Syntax

DeflateArray(arrDeflate)

Formal Parameters

arrDeflate

The array containing duplicate elements.

Return value

The DeflateArray function's return value is a variant array. This array will contain the elements of arrDeflate minus duplicate elements. You must assign the return to a variant variable.

Function

Function DeflateArray(arrDeflate As Variant) As Variant
Dim arrNew As Variant
Dim x As Integer
x = 1
Redim arrNew(x)
Dim nCount As Integer

Forall v In arrDeflate
nCount = 0 '-- Counter for arrDeflate elements
For i = 1 To Ubound(arrNew) '-- Loop through array
If arrNew(i) = v Then '-- Check current arrNew to ensure there are no duplicate values
nCount = nCount + 1 '-- bump counter if duplicate is found
End If
Next i '-- End Loop check for duplicate members
'-- If there are no duplicate values then assign element to arrNew
If nCount = 0 Then '-- Counter was never bumped then no duplicate exist so add new element to arrNew
Redim Preserve arrNew(x) '-- Redim arrNew to make room for new element
arrNew(x) = v '-- Assign new element to arrNew
x = x + 1 '-- Bump arrNew counter for future redim
End If
End Forall
DeflateArray = arrNew
End Function

Usage

The valid values for the arrDeflate elements are alphanumeric characters. This will remove all duplicate elements from the array. Assign the return to a variant variable.

Example

This example will take an array of elements containing duplicate names. The function DeflateArray will remove all duplicate elements and pass back the array as a variant. The array will then be formated into a string variable for display in messagebox.

Sub Click(Source As Button)
Dim MyArray(8) As String
MyArray(0) = "Tim"
MyArray(1) = "Gina"
MyArray(2) = "Paul"
MyArray(3) = "Tom"
MyArray(4) = "Gina"
MyArray(5) = "Tim"
MyArray(6) = "Tom"
MyArray(7) = "Peter"
MyArray(8) = "Gina"
Dim ViewArray As String

Forall v In MyArray
'-- Concatenate each element in array to sViewCust for display to screen via messagebox
If ViewArray = "" Then
ViewArray = v
Else
ViewArray = ViewArray & Chr$(13) & v
End If
End Forall
Messagebox "Array Elements: " & Chr(13) & Chr(13) & ViewArray, , "Elements in Aray before call to DeflateArray"

Dim sNewArray As Variant
sNewArray = DeflateArray(MyArray)
ViewArray = ""

Forall q In sNewArray
'-- Concatenate each element in array to sViewCust for display to screen via messagebox
If ViewArray = "" Then
ViewArray = q
Else
ViewArray = ViewArray & Chr$(13) & q
End If
End Forall

Messagebox "Array Elements: " & Chr(13) & Chr(13) & ViewArray, , "Elements in Array After call to DeflateArray"
End Sub