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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
671
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi

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!
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
671
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Ah, I've just seen Michael's question, thanks. Yes, I ran it and it works for Indoor Bike (as I'd requested) but also searches the other 2 sheets, which is when I realised I should have known that and been clear when I posted. I haven't as yet run your code as I assumed it would have the same issue because of my mistake?
 

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,434
This will search the two Training sheets or just Indoor Bike by itself depending on which sheet is active.

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 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
            
            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
 
Solution

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
671
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Many thanks AlphaFrog, that works perfectly!

Thanks also, Michael, what you did was perfectly OK as ever, my apologies again.
 

Forum statistics

Threads
1,143,677
Messages
5,720,257
Members
422,273
Latest member
linds75

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top