Library code snippets
Array Functions
By Nick Avery, published on 31 Dec 2001
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.
Related articles
Related discussion
-
VB6 Runtime error 381 subsript out of range Error
by Uncle (2 replies)
-
passing and reading parameters from using Shell
by jigartoliya (0 replies)
-
Convert C++ code to VB6
by mawcot (4 replies)
-
Help to Call ASP function from onclick event in HTML to pass an array
by vka (0 replies)
-
listbox scrollbar
by Dennijr (10 replies)
Related podcasts
-
Inside Scripting - VBScript, WMI and ADSI Unleashed- Part 2
Join host Ted Neward as he discusses the SQL server 2005 database administration with "VB Script, WMI, and ADSI" author Don Jones, in part two of this video series.
This thread is for discussions of Array Functions.