Button or form to go to specific date of today's date

[Sacruzsa]

Hello everyone ,
At work a colleague has created a calendar for filling in the activity of all our personnel, now this is not user-friendly in my opinion because it is 1 elongated list for the whole year, it is also very annoying since if someone enters something in August and closes the excel, the next person arrives on this day so I wondered if it is possible to make a button or form in which 2 things should happen
1. Go to specific date in the sheet (search bar)
2. go to today
Is that possible , and how do I get started ?

 

[offthelip]

You haven't said where your list of dates is so I have assumed it is column A going from row 1 to row 365
These two macros will do what you have asked for, you just need to create two buttons to trigger them. You can try just running them without the buttons to test them:

Sub gotoday()
Dim tt As Long

Inarr = Range(Cells(1, 1), Cells(365, 1))
tt = Application.WorksheetFunction.RoundDown(Now(), 0)
For i = 1 To 365
If tt = Inarr(i, 1) Then
 Cells(i, 1).Select
 Exit For
End If
Next i

End Sub

Sub gotodate()
Dim tt As Long
Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date")
If IsDate(TheString) Then
    TheDate = DateValue(TheString)
Else
    MsgBox "Invalid date"
     Exit Sub
End If

Inarr = Range(Cells(1, 1), Cells(365, 1))
tt = TheDate
For i = 1 To 365
If tt = Inarr(i, 1) Then
 Cells(i, 1).Select
 Exit For
End If
Next i

End Sub

 

[Sacruzsa]

You haven't said where your list of dates is so I have assumed it is column A going from row 1 to row 365
These two macros will do what you have asked for, you just need to create two buttons to trigger them. You can try just running them without the buttons to test them:

Sub gotoday()
Dim tt As Long

Inarr = Range(Cells(1, 1), Cells(365, 1))
tt = Application.WorksheetFunction.RoundDown(Now(), 0)
For i = 1 To 365
If tt = Inarr(i, 1) Then
 Cells(i, 1).Select
 Exit For
End If
Next i

End Sub

Sub gotodate()
Dim tt As Long
Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date")
If IsDate(TheString) Then
    TheDate = DateValue(TheString)
Else
    MsgBox "Invalid date"
     Exit Sub
End If

Inarr = Range(Cells(1, 1), Cells(365, 1))
tt = TheDate
For i = 1 To 365
If tt = Inarr(i, 1) Then
 Cells(i, 1).Select
 Exit For
End If
Next i

End Sub

Hello Offthelip

The given code doesn't work for going to today's date I used the code below:

Sub Select_Today()
Cells.Find(Date, , xlValues, xlWhole).Select
End Sub

For the code 'Search for date' I probably have to enter the correct cells and rows but I have already entered everything and nothing works, the part to enter a date works but nothing happens when I enter a date, also no error message
In the image below you can see which cells are used, hopefully you can help me further

 

[offthelip]

Read the first sentence of my post that is why it doesn't work. I am not at a computer at the moment and not able ti write code

 

[Sacruzsa]

Read the first sentence of my post that is why it doesn't work. I am not at a computer at the moment and not able ti write code

Yes I have read that , the problem is that I do not know what to enter at all , I have already tried everything with an error code as a result

 

[offthelip]

I am now back at a PC, so I assume from your picture that the dates are in row 4 , so try this:

Sub gotoday()
Dim tt As Long

Inarr = Range(Cells(4, 1), Cells(4, 365))
tt = Application.WorksheetFunction.RoundDown(Now(), 0)
For i = 1 To 365
If tt = Inarr(1, i) Then
 Cells(4, i).Select
 Exit For
End If
Next i

End Sub

Sub gotodate()
Dim tt As Long
Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date")
If IsDate(TheString) Then
    TheDate = DateValue(TheString)
Else
    MsgBox "Invalid date"
     Exit Sub
End If

Inarr = Range(Cells(4, 1), Cells(4, 365))
tt = TheDate
For i = 1 To 365
If tt = Inarr(1, i) Then
 Cells(4, i).Select
 Exit For
End If
Next i

End Sub

 

[Sacruzsa]

I am now back at a PC, so I assume from your picture that the dates are in row 4 , so try this:

Sub gotoday()
Dim tt As Long

Inarr = Range(Cells(4, 1), Cells(4, 365))
tt = Application.WorksheetFunction.RoundDown(Now(), 0)
For i = 1 To 365
If tt = Inarr(1, i) Then
 Cells(4, i).Select
 Exit For
End If
Next i

End Sub

Sub gotodate()
Dim tt As Long
Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date")
If IsDate(TheString) Then
    TheDate = DateValue(TheString)
Else
    MsgBox "Invalid date"
     Exit Sub
End If

Inarr = Range(Cells(4, 1), Cells(4, 365))
tt = TheDate
For i = 1 To 365
If tt = Inarr(1, i) Then
 Cells(4, i).Select
 Exit For
End If
Next i

End Sub

Offthelip,
Now it works perfectly, both buttons do what they should, I can't thank you enough
thank you for the assistance