Need small amendment for code to run in 3 sheets instead of 2

[Ironman]

Hi

The below code was kindly given to me and currently runs only in 2 sheets 'Training Log' and 'Training 1981-1997'.

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!

 

[Michael M]

Do you have other code somewhere that makes this MsgBox "TRUE" ??

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

 

[Ironman]

G'day Michael

Is this what you're missing?

This code is in the 2 existing worksheets and I'll just copy it to the third one:

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)

    If target.Column = 1 And target.Row > 11 Then
        Call FindDate
    End If

 

[Michael M]

Shouldn't it only need some Msg changes and the Indoor bike added to the first statement??
Note the comments in the code

Sub FindDate()
    Dim myDt As Date, myInput As Variant, CellFound As String
    Dim ws1 As Worksheet, ws2 As Worksheet
 
    If ActiveSheet.Name <> "Indoor Bike" And 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" 'change this message
        Exit Sub
    Else
        Set ws1 = ActiveSheet 'make sure the activesheet is the correct one
        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") 'change this message
 
    If myInput = "" Then
        MsgBox "Search cancelled!", vbInformation, "Locate Training Log Entry Date" 'change message
        Exit Sub
    End If
 
    If IsDate(myInput) Then
        myDt = myInput
     
        On Error Resume Next
        CellFound = Application.Match(CDbl(myDt), ws1.Range("A:A"), 0) 'is the range the same for Indoor Bike
     
        If CellFound <> "" Then
            ws1.Range("A" & CellFound).Activate
            Exit Sub
        Else
            CellFound = Application.Match(CDbl(myDt), ws2.Range("A:A"), 0) 'is the range the same for Indoor Bike
            If CellFound <> "" Then
                ws2.Activate 'this still correct ??
                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" 'change message
End Sub

 

[Ironman]

Yes, but I was stuck with this bit as I was thinking a change needs to be made here too?

    Else
        Set ws1 = ActiveSheet 'make sure the activesheet is the correct one
        If ws1.Name = "Training Log" Then
            Set ws2 = ThisWorkbook.Worksheets("Training 1981-1997")
        Else
            Set ws2 = ThisWorkbook.Worksheets("Training Log")
        End If
    End If

 

[Michael M]

But that code will only change the criteria if the active sheet is "Training log"
If the activesheet is Indoor Bike it will make ws2 "Training Log"
The obvious question here is did you try it using F8 to see what happens ??

 

[AlphaFrog]

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 Training Log Entry Date", Type:=2)
            If myInput = "" Or myInput = "False" Then
                MsgBox "Search cancelled!", vbInformation, "Locate Training 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
            
            For Each ws In Sheets(Array("Training Log", "Training 1981-1997", "Indoor Bike"))
                CellFound = Application.Match(CLng(CDate(myInput)), ws.Range("A:A"), 0)
                If Not IsError(CellFound) Then Exit For
            Next ws
            
            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

 

[Ironman]

Ahhh! Yes, it works great now I've added

If ActiveSheet.Name <> "Indoor Bike" And ActiveSheet.Name <> "Training Log" And ActiveSheet.Name <> "Training 1981-1997" Then

No issue amending the messages, thanks once again Michael!

 

[Michael M]

Note the excellent update from @AlphaFrog ...

 

[Ironman]

Many thanks for your solution AlphaFrog!

I'm really sorry though, I've just realised - the existing code correctly searches both Training Log and Training 1981-1997 sheets for dates in either of those sheets.

The new Indoor Bike code above is also searching those 2 sheets, which I don't want, as I only want the new code for the additional Indoor Bike sheet to search the Indoor Bike sheet in the same range but in that sheet only.

Sorry about that!