Utility functions

Functions which can be re-used across projects.

RefreshAdvancedFilter is a convenience function which, well, refreshes an advanced filter. This lets you take advantage of the Excel advanced filter to extract entries from a range based on specified criteria. Using the database rngSource, manipulate the parameters to an SQL-like query in rngCriteria to produce the extract in rngExtract.

Public Sub RefreshAdvancedFilter( _
    ByRef rngCriteria As Excel.Range, _
    ByRef rngExtract As Excel.Range, _
    ByRef rngSource As Excel.Range, _
    Optional ByVal IsCopy As Boolean = True, _
    Optional ByVal IsUnique As Boolean = False)
' Refreshes advanced filter of the source range
Dim lCopy As Long

lCopy = IIf(IsCopy, xlFilterCopy, xlFilterInPlace)

rngSource.AdvancedFilter Action:=lCopy, _
    criteriarange:=rngCriteria, copytorange:=rngExtract, _
    unique:=IsUnique

End Sub

Sample Array takes a random sample without replacement from an array:

Public Sub SampleArray( _
    ByRef avBigset As Variant, _
    ByRef avSmallset As Variant)
' SampleArray populates a random sample avSmallset
' from an array avBigset without replacement
' (each element in avBigset is considered once only)
Dim lRemainder As Long
Dim lSize As Long
Dim lOb As Long
Dim lPickit As Long

' Make sure we're dealing with arrays...
If Not IsArray(avBigset) Or Not IsArray(avSmallset) _
    Then Exit Sub
' Initialise
lRemainder = UBound(avBigset)
lSize = UBound(avSmallset)
Randomize 0

Do While lSize > 0  ' Still some left to pick up
    lOb = lOb + 1
    If Rnd < lSize / lRemainder Then
        lPickit = lPickit + 1
        avSmallset(lPickit) = avBigset(lOb)
        lSize = lSize - 1
    End If
    lRemainder = lRemainder - 1
Loop    ' Sample complete

End Sub

CountDistinct gets a count of distinct values from an array:

Public Function CountDistinct(ByRef vArr As Variant) As Variant

    Dim dict As Scripting.Dictionary
    Dim lVal As Long

    Set dict = New Scripting.Dictionary

    For lVal = LBound(vArr) To UBound(vArr)
        dict(vArr(lVal)) = vArr(lVal)
    Next lVal

    CountDistinct = dict.Count

End Function