Out of Stack Space - How to optimize VBA code

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))