Private Sub Workbook_Open()
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
startover:
Dim Ans As Integer
Ans = MsgBox("Would you like to enter an appointment?" _
& vbNewLine & vbNewLine & "Click YES to continue step by step instructions" _
& vbNewLine & vbNewLine & "Click NO to enter the appointment manually" _
& vbNewLine & vbNewLine & "Click CANCEL to exit transport", vbYesNoCancel + vbQuestion, "ROOM NUMBER")
Select Case Ans
Case vbYes
Columns("B:B").Select 'apt num col
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:
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
'move one cell to the right from the last used cell
ActiveCell.Offset(0, 1).Select
'ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd
'get user appt date input
Dim dInput As String
Dim dMyDate As Date
Dim DayNumber As Integer
Dim dayname As String
Retry:
dInput = InputBox("Enter the date in mm/dd/yy format: ")
If IsDate(dInput) Then
dMyDate = Format(dInput, "mm/dd/yyyy")
Else
MsgBox dInput & " is not a valid date format."
GoTo Retry
End If
If dMyDate < Date Then
MsgBox (dMyDate & " was entered." & vbNewLine & vbNewLine & "That date has past")
GoTo Retry
Else
End If
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:
MsgBox ("The date entered falls on " & dayname & "." & vbNewLine & "Monday and Wednesday are the only valid medical appointment days.")
GoTo Retry
Case 2
dayname = "Monday"
GoTo apptdate
Case 4
dayname = "Wednesday"
GoTo apptdate
End Select
apptdate:
ActiveCell = dInput
'ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt
'Call Public Sub CommandButton1_Click() 'THIS LINE WAS NOT PART OF MY ORIGINAL ATTEMPT
'appt time
'fix this code to provide for error trapping
ActiveCell.Offset(0, 1).Select
Dim tInput As String
Dim tMyTime As Date
'WHENandWHEREUserForm.Show 'THIS LINE WAS ALSO NOT PART OF THE ORIGINAL ATTEMPT
tRetry:
'tInput = InputBox("Enter the appointment time" & vbNewLine & "in hour : minute format: ")
' If IsDate(tInput) Then
' tMyTime = Format(tInput, "hh:mm")
' Else
'MsgBox tInput & " is not a valid time format."
'GoTo tRetry
'End If
'ActiveCell = tMyTime
'nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn
'Doc's name
ActiveCell.Offset(0, 1).Select
'town
'disallow appt if time is wrong
ActiveCell.Offset(0, 1).Select
'get user input for address
ActiveCell.Offset(0, 1).Select
Case vbCancel
Workbooks("transport.xlsm").Close SaveChanges:=True
Case vbNo
End Select
End Sub