Search 2 sheets for a date

Ironman

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

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

VBA Code:
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
VBA Code:
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!
 
Last edited:

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Crystalyzer

Well-known Member
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
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

VBA Code:
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

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

Ironman

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

Well-known Member
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
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

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

ADVERTISEMENT

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

Well-known Member
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
If it finds the date in Sheet 1 should it stop or continue to search in Sheet 20
 

Ironman

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

ADVERTISEMENT

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

Crystalyzer

Well-known Member
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
This should do it

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
 
Solution

Ironman

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

Well-known Member
Joined
Oct 18, 2011
Messages
688
Office Version
  1. 365
Platform
  1. Windows
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?
 

Forum statistics

Threads
1,148,396
Messages
5,746,447
Members
424,020
Latest member
LongDoo

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