1

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

Improve this question
7
  • 1
    Are you actually getting an error or is this all theoretical? Commented Jan 12, 2021 at 9:35
  • Avoid ReDim Preserve this comes with extremly high costs. Commented Jan 12, 2021 at 9:35
  • If this is actual data in a database, I suggest you write a SQL query to do it instead. Commented Jan 12, 2021 at 9:36
  • 1
    If this is not data in a database I recomment to use a real database like SQL for your data. Excel is no database! Commented Jan 12, 2021 at 9:36
  • 1
    Even if it's not data in a database, I would recommend using SQL, as most performant and declarative (which for VBA admittedly isn't saying very much). Commented Jan 12, 2021 at 9:44

1 Answer 1

Reset to default
3

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

Improve this answer
Sign up to request clarification or add additional context in comments.

11 Comments

You could remove the recursive step entirely and transform it into a Do Until loop.
@Tomalak Yes, that would save the creation of a new stack frame each time the function is called. I just made a quick answer that would not confuse the OP too much
Hm, I think removing recursion would actually result in a less confusing solution, especially for a beginner. Also it would literally never run out of stack space.
@VI55 You would do something like x = GetDatePositions(db, myDate) and you can then use x as you would have used DateSave. Alternatively, you could return the Collection instead of transforming to an array of Long
@VI55 If you read the above reply, where I called it x then yes, you could do LBound(x,1) if you need to. Anyway, I am just editing the answer with a bigger improvement. Just refresh the page in a couple of seconds
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.