![]() |
Validate Appointment Times?
Here's what I have:
One master spreadsheet One data entry spreadsheet - appointments are copied to the master spreadsheet's next available row. My program searches through each row to see if there is an appointment conflict before the appointment is copied. I just can't seem to get it to work though! It works if the dates or times are equal. For example, if there is an existing appointment for 3:30 - 4:30 and I try to add one for 4:00 - 5:00, the program will allow it (probably because my code and/or logic is wrong). My code is as follows: Sub UpdateMaster() ' Macro1 Macro ' Macro recorded 12/11/2003 by 787940 ' Dim r As Integer Dim MyRow As Integer Dim ApptDate As Date Dim ApptStart As Date Dim ApptEnd As Date MyRow = ActiveCell.Row ApptDate = Range("D" & MyRow).Value ApptStart = Range("E" & MyRow).Value ApptEnd = Range("F" & MyRow).Value 'MsgBox "Apptdate: " & ApptDate & " Apptstart: " & ApptStart & " apptdur: " & ApptDur & " apptend: " & ApptEnd 'Exit Sub Range("A" & MyRow & ":F" & MyRow).Select Application.CutCopyMode = False Selection.Copy Sheets("Master").Select r = 2 Dim CheckApptDate, CheckApptStart, CheckApptEnd As Date Do 'Set the variables CheckApptDate = Range("D" & r).Value CheckApptStart = Range("E" & r).Value CheckApptEnd = Range("F" & r).Value 'Check the appointment date If ApptDate = CheckApptDate Then 'Check the start time If ApptStart = CheckApptStart Then MsgBox "This appointment time already exists. Please select another time." Application.CutCopyMode = False Range("D" & r).Select Exit Sub Else If ApptStart CheckApptStart And ApptEnd CheckApptEnd Then MsgBox "This appointment conflicts with another appointment. Please select another time." Application.CutCopyMode = False Range("D" & r).Select Exit Sub End If End If Else 'do nothing End If r = r + 1 Loop Until Cells(r, 256).End(xlToLeft).Column = 1 And Cells(r, 1) = "" Cells(r, 1).Select ActiveSheet.Paste Link:=True Application.CutCopyMode = False End Sub Thanks in advance for your help! Shelley |
All times are GMT +1. The time now is 05:27 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com