Ironman
Well-known Member
- Joined
- Jan 31, 2004
- Messages
- 1,069
- Office Version
- 365
- Platform
- Windows
Hi
I was kindly given the below code a couple of months ago in this thread, that searches for a date I input when I double click a cell in Col A I and it works perfectly.
However, I have had to change the date format of sheet 'Training 1981-1997' to the (custom number) format d/m/yy dddd and unsurprisingly, the search won't work for that sheet with the original code.
I'd be very grateful, if it's possible, for an amendment to the above code that will allow the search function to continue working in this sheet.
Many thanks!
I was kindly given the below code a couple of months ago in this thread, that searches for a date I input when I double click a cell in Col A I and it works perfectly.
VBA Code:
Sub FindDate()
Dim myInput As Variant
Dim CellFound As Variant
Dim ws As Worksheet
Select Case ActiveSheet.Name
Case "Training Log", "Training 1981-1997", "Indoor Bike"
Retry:
myInput = Application.InputBox("Enter Date:", "Locate Log Entry Date", Type:=2)
If myInput = "" Or myInput = "False" Then
'MsgBox "Search cancelled!", vbInformation, "Locate Log Entry Date"
Exit Sub
ElseIf Not IsDate(myInput) Then
MsgBox "Only enter a valid date format.", vbExclamation, "Invalid Date Entry"
GoTo Retry
End If
Select Case ActiveSheet.Name
Case "Training Log", "Training 1981-1997"
For Each ws In Sheets(Array("Training Log", "Training 1981-1997"))
CellFound = Application.Match(CLng(CDate(myInput)), ws.Range("A:A"), 0)
If Not IsError(CellFound) Then Exit For
Next ws
Case "Indoor Bike"
Set ws = ActiveSheet
CellFound = Application.Match(CLng(CDate(myInput)), ws.Range("A:A"), 0)
End Select
If Not IsError(CellFound) Then
Application.GoTo ws.Range("A" & CellFound)
Else
MsgBox "Sorry, no entry found for " & myInput, vbInformation, "No Match Found"
End If
Case Else
MsgBox "The Locate Entry Date function will only run on:" & _
vbLf & " Training Log" & _
vbLf & " Training 1981-1997" & _
vbLf & " Indoor Bike", _
vbInformation, "Invalid Sheet"
End Select
End Sub
I'd be very grateful, if it's possible, for an amendment to the above code that will allow the search function to continue working in this sheet.
Many thanks!