The source code below gives you some various array functions, which should be self-explanatory. ArrayDimensions will count the amount of dimensions in the given array. All the other functions will only except single dimension arrays
Public Function ArraySearch(SearchFor As Variant, Arry As Variant) As Integer
If (VarType(Arry) And vbArray) <> vbArray Then Exit Function
If ArrayDimensions(Arry) <> 1 Then Exit Function
If LBound(Arry) = 0 And UBound(Arry) = 0 Then Exit Function
Dim X As Integer
ArraySearch = 0
For X = LBound(Arry) To UBound(Arry)
If Arry(X) = SearchFor Then
ArraySearch = X
Exit Function
End If
Next
End Function
Public Function ArrayAppend(Arry As Variant, Add As Variant)
Dim X As Integer
If (VarType(Arry) And vbArray) <> vbArray Then Exit Function
If ArrayDimensions(Arry) = 0 Then ReDim Preserve Arry(0 To 0)
If ArrayDimensions(Arry) <> 1 Then Exit Function
For X = LBound(Add) To UBound(Add)
ReDim Preserve Arry(LBound(Arry) To UBound(Arry) + 1)
If IsObject(Add(X)) = True Then
Set Arry(UBound(Arry)) = Add(X)
Else
Arry(UBound(Arry)) = Add(X)
End If
Next
ArrayAppend = Arry
End Function
Public Function ArrayRemove(Arry, Remove, Optional RemoveAll As Boolean = True)
Dim X As Integer
If (VarType(Arry) And vbArray) <> vbArray Then Exit Function
If ArrayDimensions(Arry) <> 1 Then Exit Function
If LBound(Arry) = 0 And UBound(Arry) = 0 Then Exit Function
If (VarType(Remove) And vbString) <> vbString Then
For X = Remove To UBound(Arry) - 1
Arry(X) = Arry(X + 1)
Next
ReDim Preserve Arry(LBound(Arry) To UBound(Arry) - 1)
Else
For X = LBound(Arry) To UBound(Arry)
If X > UBound(Arry) Then Exit For
If Str(Arry(X)) = Remove Then
Arry = ArrayRemove(Arry, X)
If RemoveAll = False Then Exit For
X = X - 1
End If
Next
End If
ArrayRemove = Arry
End Function
Public Function ArrayDimensions(Arry)
On Error GoTo ErrorHandler
Dim ThisDim As Long
Dim ThisTest As Long
If (VarType(Arry) And vbArray) = vbArray Then
ThisDim = 0
Do
ThisTest = UBound(Arry, ThisDim + 1)
ThisDim = ThisDim + 1
Loop
End If
ArrayDimensions = 0
Exit Function
ErrorHandler:
Select Case Err.Number
Case 9
ArrayDimensions = ThisDim
Case Else
MsgBox Err.Description & "(" & Err.Number & ")", vbExclamation
End Select
End Function
I am as a web developer for a small company, working for a small company. I work on banking websites and verious related projects.
Comments