Out of Stack Space - How to optimize VBA code - excel

Question

I am writing a code to retrieve a specific date in a (somewhat) large excel spreadsheet(2,000 entries).
I just realize that my code will not work and it will only get worse. Could you please advise me.
I give to my function:
array() that contain my data from an excel spreadsheet
FirstDate which is the date I am looking for, as dd mm yyyy
DateSave() to save all the position where this date appears (multiple transaction on the same day)
The code will not be able to work with a database of 5,000 row as it will have to stack it if the date is at the end of the table. What could I do to fix this issue?
Thank you very much
Function looping(array() As Variant, FirstDate As Date, DateSave() As Long)
Dim i As Long
Dim PositionInArray As Long
PositionInArray = 0
For i = LBound(array, 1) To UBound(array, 1)
If array(i, 1) = FirstDate Then
ReDim Preserve DateSave(PositionInArray)
DateSave(PositionInArray) = i
PositionInArray = PositionInArray + 1
End If
'If end of list and array not initialize ie. Not value in it
If i = UBound(array, 1) And (Not DateSave) = -1 Then
Call looping(array(), FirstDate + 1, DateSave())
ElseIf i = UBound(array, 1) Then
'Array has been initialized
Exit For
End If
Next i
End Function
Edit: Change data base to excel spreadsheet

Answer 1

I've renamed the function and parameters. The function returns the result rather than having a ByRef parameter. I've used a collection to store the row indexes.
Function GetDatePositions(ByRef database() As Variant, ByVal searchDate As Date) As Long()
Const colDates As Long = 1 'the index of the column holding dates
Dim i As Long
Dim collRowIndexes As New Collection
For i = LBound(database, 1) To UBound(database, 1)
If database(i, colDates) = searchDate Then
collRowIndexes.Add i
End If
Next i
If collRowIndexes.Count = 0 Then
GetDatePositions = GetDatePositions(database, searchDate + 1)
Exit Function
End If
Dim res() As Long
ReDim res(0 To collRowIndexes.Count - 1)
Dim v As Variant
i = 0
For Each v In collRowIndexes
res(i) = v
i = i + 1
Next v
GetDatePositions = res
End Function
EDIT
There is no need to search each consecutive date. We just need to keep track of the next date that is bigger than the search date.
Function GetDatePositions(ByRef database() As Variant, ByVal searchDate As Date) As Long()
Const colDates As Long = 1 'the index of the column holding dates
Dim i As Long
Dim collRowIndexes As New Collection
Dim dateFound As Boolean
Dim nextDate As Date
Dim tempDate As Date
dateFound = False
For i = LBound(database, 1) To UBound(database, 1)
tempDate = database(i, colDates)
If tempDate = searchDate Then
dateFound = True
collRowIndexes.Add i
Else
If Not dateFound Then
If searchDate < tempDate Then
If nextDate = 0 Then
nextDate = tempDate
ElseIf tempDate < nextDate Then
nextDate = tempDate
End If
End If
End If
End If
Next i
'
If collRowIndexes.Count = 0 Then
If nextDate = 0 Then
Err.Raise 5, "GetDatePositions", "No date found"
Else
GetDatePositions = GetDatePositions(database, nextDate)
Exit Function
End If
End If
Dim res() As Long
ReDim res(0 To collRowIndexes.Count - 1)
Dim v As Variant
i = 0
For Each v In collRowIndexes
res(i) = v
i = i + 1
Next v
GetDatePositions = res
End Function
Obviously, an assumption that all dates are rounded is made. But if dates also contain time (hours, minutes, seconds) then tempDate = database(i, colDates) needs to be replaced with tempDate = VBA.Int(database(i, colDates))