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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
871
Office Version
  1. 365
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

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
21,104
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Do you have other code somewhere that makes this MsgBox "TRUE" ??
Rich (BB code):
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

Well-known Member
Joined
Jan 31, 2004
Messages
871
Office Version
  1. 365
Platform
  1. Windows
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:
VBA Code:
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

Well-known Member
Joined
Oct 27, 2005
Messages
21,104
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Shouldn't it only need some Msg changes and the Indoor bike added to the first statement??
Note the comments in the code
Rich (BB 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

Well-known Member
Joined
Jan 31, 2004
Messages
871
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Yes, but I was stuck with this bit as I was thinking a change needs to be made here too?
VBA Code:
    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

Well-known Member
Joined
Oct 27, 2005
Messages
21,104
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,436

ADVERTISEMENT

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

Well-known Member
Joined
Jan 31, 2004
Messages
871
Office Version
  1. 365
Platform
  1. Windows
Ahhh! Yes, it works great now I've added
VBA Code:
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!
 

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
871
Office Version
  1. 365
Platform
  1. Windows
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!
 
Last edited:

Forum statistics

Threads
1,148,390
Messages
5,746,432
Members
424,016
Latest member
Shizzl

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