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:
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
Last edited: