Need code modifying to search date in custom format

[Ironman]

Hi

I was kindly given the below code a couple of months ago in this thread, that searches for a date I input when I double click a cell in Col A I and it works perfectly.

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 Log Entry Date", Type:=2)
            If myInput = "" Or myInput = "False" Then
                'MsgBox "Search cancelled!", vbInformation, "Locate 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

However, I have had to change the date format of sheet 'Training 1981-1997' to the (custom number) format d/m/yy dddd and unsurprisingly, the search won't work for that sheet with the original code.

I'd be very grateful, if it's possible, for an amendment to the above code that will allow the search function to continue working in this sheet.

Many thanks!

 

[dmt32]

Hi Dave, many thanks for replying.

I ran your code and did the search and it unfortunately still returned "Sorry, no entry found for " & myInput, vbInformation, "No Match Found"

Curious - just downloaded your file & run it & all worked ok.

When you click on a date do you just see the date in the formula bar e.g (26/04/1985)?

Dave

 

[Ironman]

Hi Dave

For input date of 26/4/85 it shows 26/4/85 and FRIDAY (below) in the formula bar (and returns "no entry found")

 

[Ironman]

P.S.

To clarify, the reason it worked for you is because the sheet you downloaded contained the date and day in upper case on the same line. Your code indeed works perfectly for that - many thanks for that.

The version that won't find the date, which I'm using right now, has the day in upper case on the next line (same row).

Is there any way you can amend the code so it will recognise this format as well please, either in lower or upper case on the next line?

Thanks again!

 

[Ironman]

P.P.S. Correction - "To clarify, the reason it worked for you is because the sheet you downloaded contained the date and day in lower case on the same line.

 

[JoeMo]

Many thanks for your perseverance Joe! I think the expression is "ball-ache" though, as there are 6,210 rows to re-enter dates manually, hence the need for code.

To avoid any more hassle I'm going to put the day (dddd) on the next line ('carriage return') in lower case. Would it be possible for you to look at the below code, which puts the "dddd" onto the next line (i.e. not a new row). I was kindly given the below code earlier that worked when the dddd was in upper case, but when I tried it again just now, it returns "Error 9, subscript out of range" and I don't know why, as nothing else has changed.

Don't think that will work. You can't add text to the date w/o the cell becoming text. You could do something like this (I'm using US region date style):

Book1.xlsm
	A	B
1	4/22/85 MONDAY	4/22/85 Monday
2	4/23/85 TUESDAY	4/23/85 Tuesday
3	4/24/85 WEDNESDAY	4/24/85 Wednesday
4	4/25/85 THURSDAY	4/25/85 Thursday
Sheet2

Cell Formulas
Range	Formula
B1:B4	B1	=LEFT(A1,FIND(" ",A1)-1)+0

format col B as (reverse month/day for your region): m/d/yy dddd. Drag the formula down to cover all of col A data then copy/pastespecial values in col B and finally delete col A so col B becomes col A. Note that when you click on a cell you see only the date (a number) in the formula bar, not the day which appears in the cell. For example A1 would be 4/22/85 Monday in the cell, but only 4/22/1985 in the formula bar. The day shows up in the cell b/c of the formatting you have chosen, but not in the formula bar b/c its not part of the serial number that represents the date.

 

[Ironman]

Thanks a lot Joe.

The day shows up in the cell b/c of the formatting you have chosen, but not in the formula bar b/c its not part of the serial number that represents the date.

Ahh, thanks for explaining that.

You might be wondering why I really want the date on a second line, well it's to replicate the format of a paper diary of archive entries that I'm digitising. I'm concluding from everything that's been said that it's not possible to search using the input box where the cell becomes text i.e. with the day on a second line, so I will need to use the Find and Replace box instead.

Many thanks for all your time and thought Joe and others.

 

[Ironman]

P.S. I have now amended the code in my original post to exclude sheet 'Training 1981-1997' in the below.

Sub FindDate()
 
    Dim myInput   As Variant
    Dim CellFound As Variant
    Dim ws        As Worksheet
         
    Select Case ActiveSheet.Name
     
        Case "Training Log", "Indoor Bike"
Retry:
            myInput = Application.InputBox("Enter Date:", "Locate Log Entry Date", Type:=2)
            If myInput = "" Or myInput = "False" Then
                'MsgBox "Search cancelled!", vbInformation, "Locate 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"
         
                    For Each ws In Sheets(Array("Training Log")) ',
                        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 in" & vbNewLine & _
                   "Training Log and Indoor Bike sheets", vbInformation, "Invalid Sheet"
         
    End Select
 
End Sub

Would it be possible for you to amend this so if a date < Jan 1 1998 is entered in sheet 'Training Log', I get a message box

Date contained in Training 1981-1997 sheet.
Please search that sheet

I OK the message box and sheet 'Training 1981-1997' is then the active sheet and the Find and Replace box opens.

Many thanks again!

 

[dmt32]

P.S.

To clarify, the reason it worked for you is because the sheet you downloaded contained the date and day in upper case on the same line. Your code indeed works perfectly for that - many thanks for that.

The version that won't find the date, which I'm using right now, has the day in upper case on the next line (same row).

The suggestion based on information provided, resolves the problem you posted but that is not how your data is actually configured?
when seeking assistance from forum it is helpful if OPs provide actual information about their data.

I cannot think of an immediate solution but helpful to forum if you post sheet with actual sample data using xl2BB or link to updated download & maybe others here can assist.

Dave

 

[Ironman]

Noted Dave, thanks and my apologies for causing the confusion.

I've still been unsuccessful trying to configure the 'Training Log' sheet code in Post #27 where if the date entered in that sheet is before 01/01/98 then I get a message box

Date contained in Training 1981-1997 sheet.
Please search that sheet

When I OK the message box then Sheet 'Training 1981-1997' is activated and the Find and Replace box then opens.

Hope you can help?

Thanks again!