excelvbadatefindcell

vba return first row number in column that has todays date or nearest date after today


VBA Code solution required. I have a column of dates in Column D of my excel spreadsheet. These dates are not continuous and so may not contain todays date and may be missing todays date. I wish to return the first row number of cell in that column that either matches todays date or if todays date doesnt exist, then select the next nearest future date after today. I wish the code to return a variable, todaydate = first row number of cell that is today or next nearest today afterwards. In the example below, if todays date was 28th February 2023, todayrow = 5 , ie the first nearest future date is 3/3/23. If today 27/3/23 then today = 2, ie first row with todays date. I am not interedted in returning a row number for nearest past dates

Row Number       Date

 1               26-Feb-23
 2               27-Feb-23
 3               27-Feb-23
 4               27-Feb-23
 5               03-Mar-23
 6               03-Mar-23
 7               03-Mar-23
 8               04-Mar-23
 9               05-Mar-23
10               05-Mar-23
11               08-Mar-23
12               07-Mar-23

Read various threads but none do exacty what I describe above in vba


Solution

  • Sub FindDate()
    
        Dim ws As Worksheet
        Dim foundCell As Range
        Dim searchDate As Date
        
        'set worksheet
        Set ws = ThisWorkbook.Sheets("Sheet1")
        
        'set search date, change accordingly
        searchDate = CDate("04-Feb-23")
        
        'search for first match date in column D
        Set foundCell = ws.Columns("D").Find(What:=searchDate, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        
        'if not found, search for first instance of a date greater than today
        Do While foundCell Is Nothing
            searchDate = searchDate + 1
            Set foundCell = ws.Columns("D").Find(What:=searchDate, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        Loop
        
        'if a match is found, select the cell and display a message
        If Not foundCell Is Nothing Then
            foundCell.Select
            MsgBox "Found date  in row " & foundCell.Row
        Else
            MsgBox "No matching date or greater than the date found"
        End If
    
    End Sub