How to find a date in a sheet?

JOHNNYC

New member
Joined
Jul 8, 2012
Messages
14
Reaction score
0
Points
0
Location
Texas
Hello,

The date in question will be obtained from the user through an input box

therefore there will be no advanced knowledge of what the specific date is going to be

so it will be placed in a variable (dInput)

the search needs to be confined to a specific row because there may be more than one row that contains that same date

the row will be located and selected by the user through a previous input box


This is the specific problematic code:
Code:
apptdate: ActiveCell.End(xlToLeft).Select  ActiveCell.EntireRow.Select  Sheet1.Select Set searchRange = Sheet1 Selection.Find(What:=dInput, After:=ActiveCell, LookIn:=xlValues, _     LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _     MatchCase:=False, SearchFormat:=False).Activate   MsgBox dInput[code/]


This is the code for the entire module:

[code]
Public Function CancelAppointment()

'------------------------------------------------------------------------------apartment number
startover:
    Dim Ans As Integer
    Ans = MsgBox("Would you like to cancel an appointment?" _
    & vbNewLine & vbNewLine & "Click YES to continue step by step instructions" _
    & vbNewLine & vbNewLine & "Click NO to exit transport", vbYesNo + vbQuestion, "ROOM NUMBER")
        Select Case Ans
            Case vbYes

GoTo getapt ' this line skips over the error code the first time through


etrap:
    MsgBox "Please enter a valid apartment number"
    GoTo getapt


        'get user to input apt num
        'apt num goes into the variable- answer
getapt:
Columns("B:B").Select 'apt num col
        Dim answer As Variant
        answer = InputBox _
        ("Type the resident's 3 digit apartment number then press ok", _
        "APARTMENT NUMBER")
        If answer = "" Then GoTo startover 'user clicked <cancel>

        'weed out non-exsistent apt nums
        If answer <= 100 Then GoTo etrap
        If answer >= 273 Then GoTo etrap
        For x = 172 To 200
        If x = answer Then GoTo etrap
        Next

    'find entered apt num in apt num col and select its cell
    Selection.Find(What:=answer, After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate


    'find last used cell on the row to the right
   ActiveCell.End(xlToRight).Select

'-----------------------------------------------------------------------------------date
  
  
  
  
    
    Dim wrongday As String
    Dim dInput As String
    Dim dmydate As Date
    Dim DayNumber As Integer
    Dim dayname As String

    'get user appointment date input
Retry:
    dInput = InputBox("Enter the date in mm/dd/yy format: ")

    'check that user did not input what is clearly NOT a date
    If IsDate(dInput) Then

        dmydate = Format(dInput, "mm/dd/yyyy") 'if the input IS a date then format it
    Else

        MsgBox dInput & " is not a valid date format."
            GoTo Retry
    End If

        'exclude dztes that have already past
         If dmydate < Date Then

        MsgBox (dmydate & " was entered." & vbNewLine & vbNewLine & "That date has past")
            GoTo Retry
        Else

        End If

        'make sure that the date is a monday or wednesday

         DayNumber = Weekday(dInput, vbSunday)


    Select Case DayNumber
        Case 1
            dayname = "Sunday"
        If dayname = "Sunday" Then GoTo wrongday

        Case 3
            dayname = "Tuesday"
        If dayname = "Tuesday" Then GoTo wrongday

        Case 5
            dayname = "Thursday"
        If dayname = "Thursday" Then GoTo wrongday

        Case 6
            dayname = "Friday"
        If dayname = "Friday" Then GoTo wrongday

        Case 7
            dayname = "Saturday"
        If dayname = "Saturday" Then GoTo wrongday


wrongday:
wrongday = MsgBox(dInput & " falls on " & dayname & "." & vbNewLine & "Monday and Wednesday are the only valid medical appointment days." _
& vbNewLine & "Please check that information supplied to you by the resident was entered accurately" & vbNewLine & _
"If the information was NOT entered correctly, then select YES to change the entry." & vbNewLine & vbNewLine & _
"If the information was entered correctly, then inform the resident that a medical appointment may not be made on " & dayname & vbNewLine & _
vbNewLine & " If the resident can make an IMMEDIATE correction, then select YES to change the entry." _
& vbNewLine & vbNewLine & "Otherwise select NO to back out of the program.", vbYesNo + vbQuestion, "Appointment Date")

Select Case wrongday

Case vbYes
    GoTo Retry
Case vbNo
   ' GoTo startover
   Call GetApartment.GetApartment
End Select

        Case 2
            dayname = "Monday"
        GoTo apptdate
        Case 4
            dayname = "Wednesday"
        GoTo apptdate
    End Select

apptdate:
ActiveCell.End(xlToLeft).Select

ActiveCell.EntireRow.Select

Sheet1.Select
Set searchRange = Sheet1
Selection.Find(What:=dInput, After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate


MsgBox dInput

  
  
 
 Case vbNo
            Workbooks("transport.xlsm").Close SaveChanges:=True
            
            
        End Select
End Function



'Sub findMethodToSearchDate()
'
'
'Dim searchDate As String, cellFound As Range, searchRange As Range, lastCell As Range
'
'Set searchRange = Sheet3.Range("A1:A100")
'
'Set lastCell = searchRange.Cells(searchRange.Cells.Count)
'
'searchDate = Format(Sheet3.Range("D2"), "Short Date")
''user enters the date he wants to find in Range: Sheet3.Range("D2").
''Format("7/18/10", "Short Date") returns "7/18/2010"; Format("7/18/10", "Long Date") returns "Sunday, July 18, 2010".
'
'
'If IsDate(searchDate) = False Then
''The IsDate function [syntax: IsDate(expression)] returns True if the expression is a valid date, else it returns False.
'
'
'MsgBox "Incorrect Date Format"
'Exit Sub
'
'
'End If
'
 

Attachments

  • DUMMY TRANSPORT.xlsm
    231.7 KB · Views: 10
Last edited:
This is the troublesome code
it can be found toward the bottom of the module.
Code:
apptdate: ActiveCell.End(xlToLeft).
Select  ActiveCell.EntireRow.Select  Sheet1.Select 
Set searchRange = Sheet1 
Selection.Find(What:=dInput, After:=ActiveCell, LookIn:=xlValues, _  
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _  
MatchCase:=False, SearchFormat:=False).Activate   
MsgBox dInput
 
Back
Top