The following is a function that will return the max value for any amount of numbers provided those numbers are passed as an array of longs (single dimension). You can pass four values or 40,000 values ir makes no difference.
The functions that begins with and end with a line of asterisks should go in a separate module. The function funMaxLng is what you call. It can go in any module you wish.
Call like maxval = funmaxlng(myarray)
Public Function funMaxLng(lngArrayin() As Long) As Long: funMaxLng = 0
Dim intLow As Integer
Dim intUpper As Integer
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Create
intLow = LBound(lngArrayin)
intUpper = UBound(lngArrayin)
Set db = CurrentDb
Set rs = db.OpenRecordset("t1", dbOpenTable)
With rs
For intLow = intLow To intUpper Step 1
.AddNew
!Value = lngArrayin(intLow)
.Update
Next
.Close
End With
strSQL = "SELECT Max(value) AS Maxvalue FROM t1"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
funMaxLng = rs!maxvalue
rs.Close
DeleteTable ("t1"

Set rs = Nothing
Set db = Nothing
End Function
Public Sub DeleteTable(ByVal tabName As String)
On Error Resume Next
CurrentDb.TableDefs.Delete tabName
On Error GoTo 0
End Sub
**********************************************************
Option Compare Database
Option Explicit
Const ERR_PROPERTY_NONEXISTENT = 3270
Const MB_YESNOCANCEL = 3
Const MB_QUESTION = 32
Const DOYES = 6
Const DONO = 7
Const DOCANCEL = 2
' ---------------------------------------------------------
' variables
' ---------------------------------------------------------
Dim wspc As Workspace
Dim dtbs As Database
Dim tabl As TableDef
Dim coln As DAO.Field
Dim refr As Relation
Dim dtbName As String
Dim newLine As String
Dim retCode As Long
' ---------------------------------------------------------
' Table exists
' ---------------------------------------------------------
Private Function DoCreateTable(tabName As String) As Integer
Dim n As Integer, resp As Integer
DoCreateTable = DOYES
On Error Resume Next
For n = 0 To dtbs.TableDefs.Count - 1
If dtbs.TableDefs

.Name = tabName Then
'resp = MsgBox("The Table '" & tabName & "' already exists in the Database. Do you want to delete it and create again ?", MB_QUESTION + MB_YESNOCANCEL, "Confirmation"

resp = DOYES
If resp = DOYES Then
' delete old Table
DeleteATable tabName
DoCreateTable = DOYES
ElseIf resp = DOCANCEL Then
wspc.Rollback
Stop
Else
DoCreateTable = DONO
End If
Exit Function
End If
Next n
End Function
' ---------------------------------------------------------
' Create a Table
' ---------------------------------------------------------
Private Sub CreateATable(tabName As String)
Debug.Print newLine & "Creating Table '" & tabName & "' ..."
On Error Resume Next
Set tabl = dtbs.CreateTableDef(tabName)
retCode = Err
On Error GoTo 0
AccTestError retCode
End Sub
' ---------------------------------------------------------
' Add a Table to the database
' ---------------------------------------------------------
Private Sub AddATable()
On Error Resume Next
dtbs.TableDefs.Append tabl
retCode = Err
On Error GoTo 0
AccTestError retCode
End Sub
' ---------------------------------------------------------
' Add a prop. for a Table
' ---------------------------------------------------------
Private Sub AddTableProp(tabName As String, PropName As String, PropType As Integer, propValue As Variant)
Dim prop As Property
On Error Resume Next
Set tabl = dtbs.TableDefs(tabName)
If Err <> 0 Then
Exit Sub
End If
tabl.Properties(PropName) = propValue
If Err <> 0 Then
If Err = ERR_PROPERTY_NONEXISTENT Then
On Error Resume Next
Set prop = tabl.CreateProperty(PropName, PropType, propValue)
tabl.Properties.Append prop
End If
On Error GoTo 0
End If
End Sub
Private Sub AddAColumn(cnam As String, dttp As Integer, mlen As Long, prec As Integer, isMand As String, rule As String, dval As String, colnNo As Integer, autoInc As String)
Dim intType As Long, intLen As Long, intPrec As Integer
intType = DB_LONG
intLen = 0
intPrec = 0
Debug.Print " Creating Column '" & cnam & "' ..."
Set coln = tabl.CreateField(cnam)
If autoInc = "YES" Then
coln.Attributes = coln.Attributes + DB_AUTOINCRFIELD
End If
coln.Type = dttp
coln.Size = mlen
If LCase(isMand) = "yes" Then
coln.Required = True
End If
coln.ValidationRule = rule
coln.DefaultValue = dval
coln.OrdinalPosition = colnNo
tabl.Fields.Append coln
retCode = Err
On Error GoTo 0
AccTestError retCode
End Sub
' ---------------------------------------------------------
' Add a Property for a Column
' ---------------------------------------------------------
Private Sub AddColumnProp(tabName As String, colName As String, PropName As String, PropType As Integer, propValue As Variant)
Dim prop As Property
On Error Resume Next
Set tabl = dtbs.TableDefs(tabName)
Set coln = tabl.Fields(colName)
If Err <> 0 Then
Exit Sub
End If
coln.Properties(PropName) = propValue
If Err <> 0 Then
If Err = ERR_PROPERTY_NONEXISTENT Then
On Error Resume Next
Set prop = coln.CreateProperty(PropName, PropType, propValue)
coln.Properties.Append prop
End If
On Error GoTo 0
End If
End Sub
' ---------------------------------------------------------
' Create an Index
' ---------------------------------------------------------
Private Sub CreateAnIndex(ByVal prim As String, ByVal uniq As String, ByVal clus As String, ByVal idxName As String, ByVal tabName As String, ByVal colList As String)
Dim idx As Index
Dim idxColumns As String
' delete old Index
DeleteAnIndex idxName, tabName
Debug.Print "Creating Index '" & idxName & "' ..."
On Error Resume Next
Set tabl = dtbs.TableDefs(tabName)
retCode = Err
On Error GoTo 0
AccTestError retCode
Set idx = tabl.CreateIndex(idxName)
idx.Name = idxName
'idx.Fields = colList
If LCase(prim) = "primarykey" Then
idx.Primary = True
End If
' If LCase(forn) = "foreignkey" Then
' idx.Foreign = True
' End If
If LCase(uniq) = "unique" Then
idx.Unique = True
End If
If LCase(clus) = "cluster" Then
idx.Clustered = True
End If
idx.Required = True
idxColumns = colList
Dim commaLoc As Integer
' set the first occurrence of ","
commaLoc = InStr(idxColumns, ","
Dim colName As String
Dim SortOrder As String
Dim fld
Do While (commaLoc > 0)
colName = Left(idxColumns, commaLoc - 1)
' trim the column names
colName = Trim(colName)
Set fld = idx.CreateField(colName)
On Error Resume Next
idx.Fields.Append fld
' the first column
idxColumns = Mid(idxColumns, commaLoc + 1)
commaLoc = InStr(idxColumns, ","

Loop
If Len(idxColumns) > 0 Then
colName = idxColumns
Set fld = idx.CreateField(colName)
idx.Fields.Append fld
End If
On Error Resume Next
tabl.Indexes.Append idx
End Sub
' ---------------------------------------------------------
' Delete an Index
' ---------------------------------------------------------
Private Sub DeleteAnIndex(ByVal idxName As String, ByVal tabName As String)
On Error Resume Next
dtbs.TableDefs(tabName).Indexes.Delete idxName
retCode = Err
On Error GoTo 0
End Sub
' ---------------------------------------------------------
' Create a Relation
' ---------------------------------------------------------
Private Sub CreateAReference(refrName As String, primTab As String, fornTab As String)
Debug.Print "Creating Relation '" & refrName & "' ..."
On Error Resume Next
Set refr = dtbs.CreateRelation(refrName)
refr.Table = primTab
refr.ForeignTable = fornTab
End Sub
' ---------------------------------------------------------
' Add joint in Relation
' ---------------------------------------------------------
Private Sub AddARefrCol(refrName As String, primKey As String, fornKey As String)
Dim fld As DAO.Field
On Error Resume Next
Set fld = refr.CreateField(primKey)
fld.ForeignName = fornKey
refr.Fields.Append fld
End Sub
' ---------------------------------------------------------
' Add current Relation
' ---------------------------------------------------------
Private Sub AddAReference(refrName As String)
On Error Resume Next
dtbs.Relations.Append refr
End Sub
' ---------------------------------------------------------
' Display err mess
' ---------------------------------------------------------
Private Sub AccTestError(ret As Long)
If ret = 0 Then Exit Sub
If ret < 0 Then ret = -ret
Debug.Print newLine & "Error : " & Error$(ret) & "."
' stop this module
Debug.Print newLine & "Database not successfully created."
'wspc.Rollback
Stop
End Sub
Sub Create()
dtbName = "Not yet specified"
newLine = Chr(13) & Chr(10)
On Error Resume Next
Set wspc = DBEngine.Workspaces(0)
Set dtbs = wspc.Databases(0)
retCode = Err
On Error GoTo 0
AccTestError retCode
wspc.BeginTrans
Debug.Print
Debug.Print "------------------------------------------------------"
Debug.Print " Creating the Database '"; dtbName; "'"
Debug.Print " in the file "; dtbs.Name
Debug.Print "------------------------------------------------------"
Debug.Print
If DoCreateTable("t1"

= DOYES Then
CreateATable "t1"
AddAColumn "pk", DB_LONG, 0, 0, "YES", "", "", 1, "YES"
AddAColumn "value", DB_LONG, 0, 0, "YES", "", "", 2, "NO"
AddATable
End If
CreateAnIndex "primarykey", "unique", "", "PK_t1", "t1", "pk"
CreateAnIndex "", "unique", "", "UNIQUE_t1_1", "t1", "pk"
' Commit transaction
wspc.CommitTrans
' End of program
Debug.Print newLine & "Database has been successfully created."
' MsgBox "Database has been successfully created.", MB_YESNOCANCEL, "Message"
'End
End Sub
************************************************************************
Robert Berman
Data Base consultant
Vulcan Software Services
thornmastr@yahoo.com