I use the sub below to check the date entered in a cell, then input a due code two cells to the left of the date cell. This occurs over the 12 months in year, three columns per month, starting in column F, row 5 and continuing to column AO.
This code works perfectly when inputting a date, however I cannot determine how to rewrite the code to work from a command button. What I want is a command button that will cycle through all the due dates and apply the new due code.
The function below is used to determine the starting date for interval one, which starting tomorrow will be the 16th to the 30th, then interval two would be the 30th to the 14th of October. Adding 14 days to each interval, but always starting with the last day of the previous interval. This continues up until the eighth interval or 112 days after the start of the first interval.
Note that I also have a statement to mark due codes of FDue if th date is over the 112 days or the eighth interval.
Also note that this will be run on the first day of the second interval and all 1Due code will be changes to Paid. So anything marked as Paid will need to be disregarded. So all 2Due will need to be marked as 1Due, 3Due as 2Due and so on, until the eighth interval, there is no 9Due to change to 8Due so the dates will need to be checked in some way to check for dates between 98 days and 112 days after the new 1Due or the old 2Due interval.
I also have named ranges setup for the due dates, BillDue, and for the due status, BillStatus. If this helps.
Any assistance would be greatly appreciated.
This code works perfectly when inputting a date, however I cannot determine how to rewrite the code to work from a command button. What I want is a command button that will cycle through all the due dates and apply the new due code.
The function below is used to determine the starting date for interval one, which starting tomorrow will be the 16th to the 30th, then interval two would be the 30th to the 14th of October. Adding 14 days to each interval, but always starting with the last day of the previous interval. This continues up until the eighth interval or 112 days after the start of the first interval.
Note that I also have a statement to mark due codes of FDue if th date is over the 112 days or the eighth interval.
Also note that this will be run on the first day of the second interval and all 1Due code will be changes to Paid. So anything marked as Paid will need to be disregarded. So all 2Due will need to be marked as 1Due, 3Due as 2Due and so on, until the eighth interval, there is no 9Due to change to 8Due so the dates will need to be checked in some way to check for dates between 98 days and 112 days after the new 1Due or the old 2Due interval.
I also have named ranges setup for the due dates, BillDue, and for the due status, BillStatus. If this helps.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
'Based on Date, Status field populates
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("BillDue")) Is Nothing Then
For Each cell In Target
If (IsDate(Target)) Then
cell.Font.Color = RGB(0, 0, 0)
cell.NumberFormat = "mm/d/yyyy"
If (Target < PayDue Or Target.Offset(0, -2) = "Paid") Then
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue And Target < PayDue + 14) Then
cell.Offset(0, -2).Value = "1Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue + 14 And Target < PayDue + 28) Then
cell.Offset(0, -2).Value = "2Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue + 28 And Target < PayDue + 42) Then
cell.Offset(0, -2).Value = "3Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue + 42 And Target < PayDue + 56) Then
cell.Offset(0, -2).Value = "4Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue + 56 And Target < PayDue + 70) Then
cell.Offset(0, -2).Value = "5Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue + 70 And Target < PayDue + 84) Then
cell.Offset(0, -2).Value = "6Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue + 84 And Target < PayDue + 98) Then
cell.Offset(0, -2).Value = "7Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= PayDue + 98 And Target < PayDue + 112) Then
cell.Offset(0, -2).Value = "8Due"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
ElseIf (Target >= 112) Then
cell.Offset(0, -2).Value = "FDue"
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(0, 0, 0)
Else
cell.Offset(0, -2).NumberFormat = "@"
cell.Offset(0, -2).Font.Color = RGB(255, 0, 0)
End If
End If
Next cell
End If
ws_exit:
Application.EnableEvents = True
End Sub
Code:
Function PayDue()
FirstPayDate = DateValue("7 Jan 2010")
PayDue = FirstPayDate + Int((Date - FirstPayDate) / 14) * 14
End FunctionAny assistance would be greatly appreciated.
