Ironman
Well-known Member
- Joined
- Jan 31, 2004
- Messages
- 1,069
- Office Version
- 365
- Platform
- Windows
Hi
The below code was kindly given to me and currently runs only in 2 sheets 'Training Log' and 'Training 1981-1997'.
I now also need it to run in sheet 'Indoor Bike' and I'd be grateful for an amendment to enable this.
Many thanks!
The below code was kindly given to me and currently runs only in 2 sheets 'Training Log' and 'Training 1981-1997'.
VBA Code:
Sub FindDate()
Dim myDt As Date
Dim myInput As Variant
Dim CellFound As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
If ActiveSheet.Name <> "Training Log" And ActiveSheet.Name <> "Training 1981-1997" Then
MsgBox "The Locate Entry Date function will only run in Training Log", vbInformation, "Function Invalid in This Sheet"
Exit Sub
Else
Set ws1 = ActiveSheet
If ws1.Name = "Training Log" Then
Set ws2 = ThisWorkbook.Worksheets("Training 1981-1997")
Else
Set ws2 = ThisWorkbook.Worksheets("Training Log")
End If
End If
myInput = InputBox("Enter Date Below: (d/m/yy)", "Locate Training Log Entry Date")
If myInput = "" Then
MsgBox "Search cancelled!", vbInformation, "Locate Training Log Entry Date"
Exit Sub
End If
If IsDate(myInput) Then
myDt = myInput
On Error Resume Next
CellFound = Application.Match(CDbl(myDt), ws1.Range("A:A"), 0)
If CellFound <> "" Then
ws1.Range("A" & CellFound).Activate
Exit Sub
Else
CellFound = Application.Match(CDbl(myDt), ws2.Range("A:A"), 0)
If CellFound <> "" Then
ws2.Activate
ws2.Range("A" & CellFound).Select
Exit Sub
Else
GoTo Error1
End If
End If
End If
Error1:
MsgBox "Sorry, no Training Log entry found for that date", vbInformation, "Search Unsuccessful"
End Sub
I now also need it to run in sheet 'Indoor Bike' and I'd be grateful for an amendment to enable this.
Many thanks!