Search 2 sheets for a date

[Ironman]

Hi

The below code searches Sheet 1 ('Training Log') for a date in Column 1.

Sub FindDate()
Dim myDt As Date
Dim myInput As Variant
Dim CellFound As String

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

    On Error GoTo Error1
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
    Else
 
    End If
 
    If IsDate(myInput) Then
        myDt = myInput
        CellFound = Application.Match(CDbl(myDt), ActiveSheet.Range("A:A"), 0)
        ActiveSheet.Range("A" & CellFound).Activate
        Exit Sub
 
    Else
 
    End If
 
Error1:
MsgBox "Sorry, no Training Log entry found for that date", vbInformation, "Search Unsuccessful"

End Sub

I'm looking for a small amendment to this so the code will also search the same column in Sheet 20 ('Training 1981-1997').

The code is also contained in Sheet 1 and Sheet 20 under

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

Can the amended code search Sheet 20 in Sheet 1 and vice versa, or can it only search the sheet that the code is in? If it won't do this, I presume it would need to be inserted in This Workbook?

Many thanks!

 

[Crystalyzer]

You can easily adjust for the active sheet by placing this code in a VBA Module and then placing the call to this in each workbooks BeforeDoubleClick event so that you only have to maintain ONE code base for FindDate

Sub FindDate()
Dim myDt As Date
Dim myInput As Variant
Dim CellFound As String

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

    On Error GoTo Error1
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
    Else
 
    End If
 
    If IsDate(myInput) Then
        myDt = myInput
        
        If ActiveSheet.Name = "Training Log" Then
            CellFound = Application.Match(CDbl(myDt), ActiveSheet.Range("A:A"), 0)
            ActiveSheet.Range("A" & CellFound).Activate
            Exit Sub
        ElseIf ActiveSheet.Name = "Training 1981-1997" Then
            CellFound = Application.Match(CDbl(myDt), ActiveSheet.Range("T:T"), 0)
            ActiveSheet.Range("A" & CellFound).Activate
            Exit Sub
        End If
    End If
 
Error1:
MsgBox "Sorry, no Training Log entry found for that date", vbInformation, "Search Unsuccessful"

End Sub

In each workbook place the following in the BeforeDoubleClick event

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Call FindDate
End Sub

 

[Ironman]

(Post #2)

Many thanks, that's a neat idea. However, before doing that, I tested your amended code in the existing FindDate module in the active sheet 'Training Log' by inputting a date contained in 'Training 1981-1997' (I corrected the ActiveSheet.Range typo ("T:T") to "A:A") and it returned "Sorry, no Training Log entry found for that date" rather than going to the relevant cell in sheet 'Training 1981-1997'.

 

[Crystalyzer]

Sorry I misunderstood, I thought in Sheet 20 (Training 1981-1997) you wanted to search column 20.

What are the search conditions?

1. When in Sheet 1 search Col ?? of Sheet ???
2. When in Sheet 20 search Col ?? of Sheet ???

 

[Ironman]

No worries.

1. When in Sheet 1 search Col 1 of Sheets 1 and 20 (and go to relevant cell)
2. When in Sheet 20 do the same (search Col 1 of Sheets 1 and 20 and go to relevant cell)

i.e. in either sheet, search Col 1 of both sheets.

 

[Crystalyzer]

If it finds the date in Sheet 1 should it stop or continue to search in Sheet 20

 

[Ironman]

It should stop (and vice versa for Sheet 20) because no dates are duplicated.

 

[Crystalyzer]

This should do it

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

 

[Ironman]

That works perfectly, thank you so much Crystalyzer!

Just one very minor thing I forgot to ask - would it be possible for you to tweak this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Call FindDate
End Sub

So double clicking does NOT run the code in Cells A1:A11 of Sheet 1 or A1 of Sheet 20?

Thanks again!

 

[Crystalyzer]

If the active cell in Sheet 1 is in A1-A11 do not run the code or exclude cells A1-A11 from the search?
If the active cell in Sheet 20 is in A1 do not run the code or exclude cells A1 from the search?