Useful Array Functions for VBA, Part 5

In my last blog post I promised to continue bombarding you with more custom functions for dealing with arrays. And I know you are excited to read more!

PHP continues to be useful in allowing us to build up a library of functions for working with arrays. In this case, we'll look at some functions for checking the intersections of two arrays and returning unique values.

Scrub duplicates from an Array

If you have an array with one or more duplicates, this method gets rid of them and returns the array sans duplicates. Currently the function only supports one dimensional arrays. The equivalent in PHP is the array_unique method.

Function Array_Unique(arr As Variant) As Variant
  Dim tempArray As Variant
  Dim i As Long

  ' start the temp array with one element and
  ' populate with first value
  ReDim tempArray(0)
  tempArray(0) = arr(LBound(arr))

  For i = LBound(arr) To UBound(arr)
    If Not IsInArray(tempArray, arr(i)) Then  ' not in destination array
      ReDim Preserve tempArray(UBound(tempArray) + 1)
      tempArray(UBound(tempArray)) = arr(i)
    End If
  Next i

  Array_Unique = tempArray
End Function

Yes, I know you can do this using a Dictionary Object (or is it a Collection? I always forget the difference). At some later date I'll post the result of my speed test.

I use the IsInArray function to check if the value being inspected is in the destination array.

Sample Usage

Dim arr As Variant

  arr = Array_Create(5)
  arr = Array("apple", "banana", "grape", "orange", "apple")
  arr = Array_Unique(arr)

Return the Intersection of two Arrays

The array_uintersect function takes two arrays and returns the values in the first array that are present in both. It does some other things I don't understand, so I chose to keep it simple and just return an array of matching values.

The following function will loop through an array and check if any of its values are present in another array. If so, the value is added to a temporary array which is passed back to the calling function.

Function Array_UIntersect(array1 As Variant, _
                          array2 As Variant) As Variant
  Dim tempArray As Variant
  Dim i As Long

  ' start with a single element
  ReDim tempArray(0)

  ' if element in first array exists in second array, keep it
  For i = LBound(array1) To UBound(array1)
    If IsInArray(array2, array1(i)) Then  ' found!
      ReDim Preserve tempArray(UBound(tempArray) + 1)
      tempArray(UBound(tempArray)) = array1(i)
    End If
  Next i

  ' first element is Empty, so shift all elements one position up
  For i = LBound(tempArray) To UBound(tempArray) - 1
      tempArray(i) = tempArray(i + 1)
  Next i
  ' remove last element
  If UBound(tempArray) <> 0 Then
    ReDim Preserve tempArray(LBound(tempArray) _
                             To UBound(tempArray) - 1)
  End If

  Array_UIntersect = tempArray
End Function

Sample Usage

This example uses functions we introduced in prior articles to create arrays, populates them with some sample data, then finds the values in the first array that exist in the second array.

  Dim arr1 As Variant
  Dim arr2 As Variant
  Dim resultArray As Variant

  arr1 = Array_Create(5)
  arr2 = Array_Create(6)

  arr1 = Split("apple,banana,grape,orange,peach", ",")
  arr2 = Split("pig,sheep,cow,bear,fox,wolf", ",")
  resultArray = Array_UIntersect(arr1, arr2)

  If UBound(resultArray) = 0 Then
    If IsEmpty(resultArray(0)) Then
      MsgBox "no elements from arr1 are in arr2"
    End If
  End If

Since there are no values in the second array that exist in the first, the function will return an empty Variant. So we need a test to see if an empty array was returned.

Let's see what happens when the arrays actually have a value in common:

  Dim arr1 As Variant
  Dim arr2 As Variant
  Dim resultArray As Variant

  arr1 = Array_Create(5)
  arr2 = Array_Create(6)

  arr1 = Split("apple,banana,grape,orange,peach", ",")
  arr2 = Split("pig,sheep,peach,bear,fox,wolf", ",")

  resultArray = Array_UIntersect(arr1, arr2)

It doesn't matter what position the matches are in; the loop ensures that matching values will be found in any position. So UBound(resultArray) = 0 and resultArray(0) = "peach".

Return the Difference of two Arrays

array_udiff returns the elements in the first array that do not appear in the second array. The code is almost exactly the same as above.

Function Array_UDiff(array1 As Variant, _
                     array2 As Variant) As Variant
  Dim tempArray As Variant
  Dim i As Long

  ' start with a single element
  ReDim tempArray(0)

  ' if element in first array does not exist in second array, keep it
  For i = LBound(array1) To UBound(array1)
    If Not IsInArray(array2, array1(i)) Then  ' not found
      ReDim Preserve tempArray(UBound(tempArray) + 1)
      tempArray(UBound(tempArray)) = array1(i)
    End If
  Next i

  ' first element is Empty, so shift all elements one position up
  For i = LBound(tempArray) To UBound(tempArray) - 1
      tempArray(i) = tempArray(i + 1)
  Next i
  ' remove last element
  If UBound(tempArray) <> 0 Then
    ReDim Preserve tempArray(LBound(tempArray) _
                             To UBound(tempArray) - 1)
  End If

  Array_UDiff = tempArray
End Function

Sample Usage

Given two arrays, the above function will return an array of the values in the first array that don't exist in the second array.

  Dim arr1 As Variant
  Dim arr2 As Variant
  Dim resultArray As Variant

  arr1 = Array_Create(5)
  arr2 = Array_Create(6)

  arr1 = Split("apple,banana,grape,orange,peach", ",")
  arr2 = Split("pig,sheep,peach,bear,fox,wolf", ",")

  resultArray = Array_UDiff(arr1, arr2)

  If UBound(resultArray) = 0 Then
    If IsEmpty(resultArray(0)) Then
      MsgBox "all elements from arr1 are in arr2"
    End If
  End If

In this case, resultArray contains
{"apple", "banana", "grape", "orange"}

. If the second array contained all of the elements of the first array, then resultArray would be
Empty

, hence the test after the function call.