VBA Macro button to go to nearest date

[stumax87]

Hi all,

I have a worksheet which is logging finances (incoming/outgoing) on the relevant dates, not every date is available if not used.
Currently I have a code which works for a specific date, it moves me to the cell with today's date. Is it possible to go to a 'nearest' date instead as this would be more suitable and more dynamic for the worksheet.

Any help with this would be appreciated, please find the current code I am using below:

Sub Find_First()
    Dim FindString As String
    Dim Rng As Range

    With Sheets("Current")
        FindString = .Range("F1")
        If Trim(FindString) <> "" Then
            With .Range("F3:F2000")
                Set Rng = .Find(What:=CDate(FindString), _
                                After:=.Cells(1), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If Not Rng Is Nothing Then
                    Application.Goto Rng, True
                Else
                    MsgBox "Nothing Found"
                End If
            End With
        End If
    End With
End Sub

 

[Yongle]

You did not fully define nearest
This finds the nearest previous date
Is this what you want?

Sub Find_First()
    Dim FindString As String, FindDate As Date, MinDate As Date
    Dim Rng As Range, LookHere As Range

    With Sheets("Current")
        Set LookHere = .Range("F3:F2000")
        MinDate = WorksheetFunction.Min(LookHere)
        FindString = .Range("F1")
        FindDate = CDate(FindString)
        
        If Trim(FindString) <> "" Then
            Do Until FindDate < MinDate
                With LookHere
                    Set Rng = .Find(What:=FindDate, After:=.Cells(1))
                    If Not Rng Is Nothing Then
                        Application.Goto Rng, True
                        Exit Sub
                    Else
                        FindDate = FindDate - 1
                    End If
                End With
            Loop
        End If
    End With
    MsgBox "not found"
End Sub

 

[stumax87]

Apologies, yes it is the nearest previous date that I would like the macro to take me to, regardless of what cell I am currently on within the worksheet.

Thanks

You did not fully define nearest
This finds the nearest previous date
Is this what you want?

Sub Find_First()
    Dim FindString As String, FindDate As Date, MinDate As Date
    Dim Rng As Range, LookHere As Range

    With Sheets("Current")
        Set LookHere = .Range("F3:F2000")
        MinDate = WorksheetFunction.Min(LookHere)
        FindString = .Range("F1")
        FindDate = CDate(FindString)
        
        If Trim(FindString) <> "" Then
            Do Until FindDate < MinDate
                With LookHere
                    Set Rng = .Find(What:=FindDate, After:=.Cells(1))
                    If Not Rng Is Nothing Then
                        Application.Goto Rng, True
                        Exit Sub
                    Else
                        FindDate = FindDate - 1
                    End If
                End With
            Loop
        End If
    End With
    MsgBox "not found"
End Sub

 

[stumax87]

Apologies, yes it is the nearest previous date that I would like the macro to take me to, regardless of what cell I am currently on within the worksheet.
I tried your code but the cell went to 12/12/2019.

You did not fully define nearest
This finds the nearest previous date
Is this what you want?

Sub Find_First()
    Dim FindString As String, FindDate As Date, MinDate As Date
    Dim Rng As Range, LookHere As Range

    With Sheets("Current")
        Set LookHere = .Range("F3:F2000")
        MinDate = WorksheetFunction.Min(LookHere)
        FindString = .Range("F1")
        FindDate = CDate(FindString)
        
        If Trim(FindString) <> "" Then
            Do Until FindDate < MinDate
                With LookHere
                    Set Rng = .Find(What:=FindDate, After:=.Cells(1))
                    If Not Rng Is Nothing Then
                        Application.Goto Rng, True
                        Exit Sub
                    Else
                        FindDate = FindDate - 1
                    End If
                End With
            Loop
        End If
    End With
    MsgBox "not found"
End Sub

 

[Yongle]

How a strange
- it always finds the date (or correct previous one) for me


What have you got in cell F1 - text or date?
And how are your dates formatted in rest of column F?

 

[stumax87]

Hello again, for some reason it now works!
I did realise that I had tried a method before submitting something on a thread, F1 was a static date in the format of 08/02/2019 which is the same format as the range, which I updated to =TODAY()
The problem persisted, since then I opened up another workbook and saw you had replied, on checking the macro again it went to the nearest previous date of 09/02/2019.

Thanks for the help, much appreciated!

 

[Yongle]

Hello again, for some reason it now works!

and you will never find out why

My guess would be that is is related to the value in F1
If F1 contains a date (not text) then would not expect use of CDate function to convert its value to a date
- but that was in your original macro

 

[stumax87]

Hello again, it appears the problem is back but this time the cell the macro goes to is the date 13/12/2019. If you remember what I highlighted yesterday the cell I was taken to was 12/12/2019. It appears that the code may be going to month 12 instead of 2, is there anything in the recent code that may need tweaking? I can't see why anything would if it eventually worked yesterday.

Very strange

 

[stumax87]

Appears to work when a static date such 15/02/2019 is on F1 but if =TODAY() is used then there is something not quite right

 

[Yongle]

That is strange.
Will test tomorrow.