Issue with VBA code I created for work

[ForbiddenOrc]

Hello,

I am extremely new at VBA coding and am trying to learn in order to make an aspect of my job much easier and less time consuming for my team. I have a spreadsheet that is used to track appointments. Reminders need to be sent 2 days before these appointments. I'm at the point where my macro can pull all of the data from my sheet, check the language, time zone, etc.. and generate reminders for me. All I have to do is click send. I'm surprised I've even been able to get here with the little knowledge I have of VBA. But I've hit a wall. I have a check that looks if the appointment is 2 days away and it mostly works except for 1 little thing that I can't figure out. So the reminders are sent 48 hours/2 days prior to the appointment time and this check needs to exclude weekends. When I run my macro today on Thursday, it generates reminders for tomorrow and for Monday which is perfect and what I want it to do. BUT, it also generates a reminder for Friday next week which is much more that 2 days away. I've tried so many different variations at this point and I'm at my wits end. Would anyone know how I can correct my function to NOT send a reminder for this upcoming Friday? For reference here is how I want the reminder needed times to be structured:

Monday appointment should generate a reminder starting on Thursday the week prior
Tuesday appointment should generate a reminder starting on Friday the week prior
Wednesday appointment should generate a reminder starting on Monday the same week
Thursday appointment should generate a reminder starting on Tuesday the same week
Friday appointment should generate a reminder starting on the Wednesday same week

Here is the code for my function. I tried separating my Thursday and Friday so they were handled separately but it always ends up breaking my code even more.

Function IsReminderNeeded(appointmentDate As Date) As Boolean
    Dim currentDate As Date
    currentDate = Date
 
    'Calculate the number of days between the appointment day and the current day
    Dim dayDiff As Integer
    dayDiff = (AppointmentWeekday(appointmentDate) - AppointmentWeekday(currentDate) + 7) Mod 7
 
    If dayDiff = 3 Or dayDiff = 4 Then
        'Thursday or Friday appointments: 
        IsReminderNeeded = (appointmentDate - currentDate) <= 4 And (appointmentDate - currentDate) >= 0
    ElseIf dayDiff = 0 Then
        'Monday appointments
        IsReminderNeeded = (appointmentDate - currentDate) <= 10 And (appointmentDate - currentDate) >= 0
    ElseIf dayDiff = 1 Then
        'Tuesday appointments
        IsReminderNeeded = (appointmentDate - currentDate) <= 11 And (appointmentDate - currentDate) >= 0
    ElseIf dayDiff = 2 Then
        'Wednesday appointments
        IsReminderNeeded = (appointmentDate - currentDate) <= 2 And (appointmentDate - currentDate) >= 0
    Else
        'Other cases: No reminder needed
        IsReminderNeeded = False
    End If
End Function

Function AppointmentWeekday(appointmentDate As Date) As Integer
    Dim weekdayNumber As Integer
    weekdayNumber = Weekday(appointmentDate, vbMonday)
    If weekdayNumber = 7 Then
        weekdayNumber = 1 'Adjust Sunday to be considered as Monday
    Else
        weekdayNumber = weekdayNumber + 1 'Shift other weekdays
    End If
    AppointmentWeekday = weekdayNumber
End Function

 

[johnnyL]

See if this simplfied version works for you:

Function IsReminderNeeded(appointmentDate As Date) As Boolean
'
    Dim currentDate     As Date
    Dim weekdayNumber   As Integer
    Dim dayDiff         As Integer
'
    currentDate = Date                                                                  ' Get the current date
'
    weekdayNumber = Weekday(appointmentDate, vbMonday)                                  ' Get the weekday number (1 = Monday, ..., 7 = Sunday) of appointmentDate
'
    If weekdayNumber <= 5 Then                                                          ' If the weekday number is from Monday to Friday (weekdayNumber <= 5) then ...
        dayDiff = WorksheetFunction.WorkDay(appointmentDate, -1) - _
                WorksheetFunction.WorkDay(currentDate, -1)                              '   Calculate the difference in workdays (weekdays) between appointmentDate & currentDate
'
        If dayDiff = 1 Or dayDiff = 2 Then                                              '   If dayDiff is either 1 or 2
            IsReminderNeeded = True                                                     '       Set IsReminderNeeded to True if the reminder is needed
        Else                                                                            '   Else ...
            IsReminderNeeded = False                                                    '       Set IsReminderNeeded to False if the reminder is not needed
        End If
    Else                                                                                ' Else ...
        IsReminderNeeded = False                                                        '   Set IsReminderNeeded to False if the appointment is on Saturday or Sunday
    End If
End Function

 

[ForbiddenOrc]

Hi Johnny,

This is so much simpler yet works much better! Thank you so much for taking the time to make this. This was the only issue/feature left and I now I can start using it. It will save me and my team so much work from having to send them manually one by one.

Thanks again and have a good day.

 

[johnnyL]

Glad to help.

 

[ForbiddenOrc]

Hello,

I just wanted to provide an update to this. The code provided above did not work as intended. When I ran my macro today it only generated a reminder for next Tuesday but I wanted it to generate reminders for two days OR LESS away. I did not make this clear in my initial request, so it is my fault.

But I was able to get it working exactly how I want by using the following function:

Function IsReminderNeeded(appointmentDate As Date) As Boolean

Dim currentDay As Integer
    currentDay = Weekday(Date, vbMonday) ' Get the current day of the week (Monday = 1, Tuesday = 2, ..., Sunday = 7)
    
    Dim startDate As Date
    Dim endDate As Date
    
    Select Case currentDay
        Case 1 ' Monday
            startDate = Date + 1
            endDate = Date + 2
        Case 2 ' Tuesday
            startDate = Date + 1
            endDate = Date + 2
        Case 3 ' Wednesday
            startDate = Date + 1
            endDate = Date + 2
        Case 4 ' Thursday
            startDate = Date + 1
            endDate = Date + 4
        Case 5 ' Friday
            startDate = Date + 3
            endDate = Date + 4
    End Select
    
End Sub

 

[johnnyL]

Doesn't get much simpler than the following:

Function IsReminderNeeded(appointmentDate As Date) As Boolean
'
    If WorksheetFunction.WorkDay(Date, 1) = WorksheetFunction.WorkDay(appointmentDate, 0) Or _
            WorksheetFunction.WorkDay(Date, 2) = _
            WorksheetFunction.WorkDay(appointmentDate, 0) Then                          ' If the appointmentDate is one or 2 weekdays away then ...
'
        IsReminderNeeded = True                                                         '   Set IsReminderNeeded to True if the reminder is needed
    Else                                                                                ' Else ...
        IsReminderNeeded = False                                                        '   Set IsReminderNeeded to False if the reminder is not needed
    End If
End Function

 

[johnnyL]

OOPS! I spoke too soon:

Function IsReminderNeeded(appointmentDate As Date) As Boolean
'
    IsReminderNeeded = WorksheetFunction.WorkDay(Date, 1) = _
        WorksheetFunction.WorkDay(appointmentDate, 0) Or _
        WorksheetFunction.WorkDay(Date, 2) = WorksheetFunction.WorkDay(appointmentDate, 0)
End Function

 

[KAPOK]

good