Array Functions

Public Function RemoveNthEntries( NthToRemove, arrayToRemoveFrom ) As Variant
'=== Removes entries from arrayToRemoveFrom whos index value is in listEntriesToRemove
'=== Returns a variant that contains an array value
'=== NthToRemove and arrayToRemoveFrom can be either a Variant that contains an array
'=== or an Array ( this is the reason there is no data type defined )

If Not Isarray( arrayToRemoveFrom ) Then Exit Function

'--- Store this return value in a variant to it can be converted into an array
Dim IndexList As Variant

Dim newList As Variant
Dim i As Integer
Dim checkList List As Integer
Dim ctr As Long
Dim lowVal As Integer, highVal As Integer
Dim numToRemove As Integer

lowVal = Lbound( arrayToRemoveFrom )
highVal = Ubound( arrayToRemoveFrom )

'--- Loop through Nth Items to be removed
Forall aValueToRemove In NthToRemove
'--- set value in list if number is in range of array bounds and is not a repeat
If Cint( aValueToRemove ) >= lowVal And Cint( aValueToRemove ) <= highVal And Not Iselement( checkList( aValueToRemove )) Then
checkList( aValueToRemove ) = 1
numToRemove = numToRemove + 1
End If
End Forall

'--- If there were not valid entries, then quit now and return NOTHING
If numToRemove = 0 Then Exit Function

'--- Resize array to hold the original number minus the number of entries being removed
Redim newList( highVal - lowVal - numToRemove )

'--- Loop through entries
ctr = 0
For i = lowVal To highVal
'--- If this index position is not in the checkList then
If Not Iselement( checkList( i ) ) Then
'--- Add it to the new array and increment counter
newList( ctr ) = arrayToRemoveFrom( i )
ctr = ctr + 1
End If
Next

RemoveNthEntries = newList
End Function

Function Explode( valueToExplode As String, Seperator As String) As Variant
'=== Gets the ValueToAdd and uses the Seperator as the
'=== delimiter to populate the Strings Array

Dim Strings As Variant

Dim myNewVal
Dim start As Integer
Dim delim As Integer
Dim ctr As Integer
Dim finalValue As String

Redim myNewVal(0)

'--- Initialize
ctr = 0
delim = 0
start = 1

'--- Get first position of Separator in valueToExplode
delim = Instr(start,valueToExplode,Seperator)

'--- If the separator was not found then set the entire valueToExplode to the first array alot
If delim = 0 Then
myNewVal(0) = valueToExplode
Else
'--- If separator found, then cycle through valueToExplode string looking for separator
' cycle until the separator is not found
While delim > 0
'--- Increment Array Preserving current value
Redim Preserve myNewVal(ctr)
myNewVal(ctr) = Mid$(valueToExplode,start,delim - start)
start = delim + Len( Seperator )
'--- Increment counter used to increment array
ctr = ctr + 1
delim = Instr(start,valueToExplode,Seperator)
Wend

'--- Now that no more seperators have been found,
'--- see if there is any final data left over
finalValue = Mid$(valueToExplode,start)

'--- If there is a finalValue then append it to the list
'--- (to handle test3 in Explode( "test1~test2~test3" ) )
If finalValue <> "" Then
Redim Preserve myNewVal(ctr)
myNewVal(ctr) = finalValue
End If
End If

'--- Reset Strings using the freshly built array
explode = myNewVal
End Function

Function Implode( valueToImplode, Seperator As String) As String
'=== Returns the value of the list or array imploded into a single string using separator

'--- If not array or list then quit
If Not Isarray( valueToImplode ) And Not Islist( valueToImplode ) Then Exit Function
Dim retVal As String
Dim hitOne As Integer

retVal = ""
'--- Loop through value to implode
Forall aVal In valueToImplode

If hitOne Then
'--- Append seperator and value to return value
retVal = retVal & Seperator & aVal
Else
'--- Set inital value of return value to first value
retVal = aVal
hitOne = True
End If
End Forall

Implode = retVal

End Function

Public Function AddValues( valuesToAdd, valuesToAddTo, iStartAt As Integer ) As Variant
'=== Adds array or single value in valuesToAdd into valuesToAddTo array starting at the
'=== iStartAt position. The remaining values are pushed up to the end.
'=== Starting at 0 inserts at the beginning Starting at -1 appends to the end
Dim iValuesToAdd As Integer
Dim iValuesInStrings As Integer
Dim newVal As Variant
If Not Isarray( valuesToAddTo ) Then Exit Function
iValuesInStrings = Ubound( valuesToAddTo) - Lbound( valuesToAddTo ) + 1

Dim iBegin As Integer
Dim ctr As Integer
Dim i As Integer
Dim iAppendFlag As Integer
ctr = 0
iAppendFlag = False

'--- Edit check iStartAt
'--- If iStartAt is Negative or above last entry in strings
If iStartAt < 0 Or iStartAt > iValuesInStrings - 1 Then
'--- Get the next available entry in Strings
iAppendFlag = True
iBegin = iValuesInStrings
Else
'--- Start where they said to start
iBegin = iStartAt
End If
'-- Calculate number of values being added
iValuesToAdd = Ubound( valuesToAdd ) - Lbound( valuesToAdd ) + 1
'--- Redim to be able to hold the new values
newVal = valuesToAddTo
Redim Preserve newVal( Lbound( newVal ) To Ubound( newVal ) + iValuesToAdd )
'--- If this is not an append operation ....
'--- Move values from iBegin and up to the end, so the new values can be inserted
If Not iAppendFlag Then
For i = iValuesInStrings + iValuesToAdd - 1 To iValuesToAdd Step -1
newVal(i) = newVal(i - iValuesToAdd)
Next
End If
ctr = Lbound( valuesToAdd )
'--- Now add the new values starting at iBegin
For i = iBegin To iBegin + iValuesToAdd - 1
newVal(i) = Cstr( valuesToAdd(ctr) )
ctr = ctr + 1
Next
AddValues = newVal
End Function

Public Function RemoveEntries( ValuesToRemove, arrayToRemoveFrom, compMethod As Integer ) As Variant
'=== Removes entries from arrayToRemoveFrom whos value is in the ValuesToRemove array
'=== Returns a variant that contains an array value
'=== ValuesToRemove and arrayToRemoveFrom can be either a Variant that contains an array
'=== or an Array ( this is the reason there is no data type defined )
'=== compMethod is used as defined in the StrCompare function;
' A number designating the comparison method. Use 0 for case-sensitive and pitch-sensitive,
' 1 for case-insensitive and pitch-sensitive, 4 for case-sensitive and pitch-insensitive,
' 5 for case-insensitive and pitch-insensitive. Use 2 to specify string comparison in
' the platform's collation sequence. If 2 is specified, strings are compared bit-wise.
' ... see help for details

If Not Isarray( arrayToRemoveFrom ) Then Exit Function

'--- Store this return value in a variant to it can be converted into an array
Dim IndexList As Variant

Dim newList As Variant
Dim i As Integer
Dim checkList List As Integer
Dim ctr As Long
Dim lowVal As Integer, highVal As Integer
Dim numToRemove As Integer
Dim foundFlag As Integer

lowVal = Lbound( arrayToRemoveFrom )
highVal = Ubound( arrayToRemoveFrom )

'--- Initialize array, we are about to use Redim preserve to incrment array size
Redim newList( 0 )

'--- Loop through entries
ctr = 0
For i = lowVal To highVal
'--- If this index position is not in the checkList then
foundFlag = False
'--- Loop through vals to remove and if there is a match flag it
Forall aValueToRemove In ValuesToRemove
If Strcompare( aValueToRemove, arrayToRemoveFrom( i ), compMethod ) = 0 Then
foundFlag = True
Exit Forall
End If
End Forall
'--- If not found in list of entries to remove, then add to new array
If Not foundFlag Then
'--- Increment array, preserving existing value
Redim Preserve newList( ctr )
'--- Set value to current value
newList( ctr ) = arrayToRemoveFrom( i )
'--- increment counter for next time 'round
ctr = ctr + 1
End If
Next

'--- Return value
RemoveEntries = newList
End Function