Excel VBA automatically updating columns (Date)

Question

I am creating a user form that does Customer Returns. I wish to have a (Status)column that will automatically update itself. It refers to the Arrival Date of the product. It works, but, when I change the system date, the status bar does not change. What do I have to do to make it update regularly? The following is the code of what ever is working.

P.S it the code works fine when entering the values. But doesn't self update

Option Explicit
Dim dDate As Date

Private Sub cbP_CodeCR_Change()
Dim row As Long

row = cbP_CodeCR.ListIndex + 2



End Sub

Private Sub Fill_My_Combo(cbo As ComboBox)
    Dim wsInventory As Worksheet
    Dim nLastRow As Long
    Dim i As Long

    Set wsInventory = Worksheets("Inventory")
    nLastRow = wsInventory.Cells(Rows.Count, 1).End(xlUp).row ' Finds last row in Column 1

    cbo.Clear
    For i = 2 To nLastRow 'start at row 2
        cbo.AddItem wsInventory.Cells(i, 1)
    Next i
End Sub

Private Sub cmdCancel_Click()
Unload CustomerReturn
End Sub

Private Sub cmdEnter_Click()
Dim cust_ID As Integer
Dim prod_Code As Integer
Dim arr_date As Date
Dim stat As String
Dim status As String
Dim rowPosition As Integer

rowPosition = 1

Sheets("Customer Return").Select

Sheets("Customer Return").Cells(1, 1).Value = "Customer ID"
Sheets("Customer Return").Cells(1, 2).Value = "Product Code"
Sheets("Customer Return").Cells(1, 3).Value = "Arrival Date"
Sheets("Customer Return").Cells(1, 4).Value = "Status"


Do While (Len(Worksheets("Customer Return").Cells(rowPosition, 1).Value) <> 0)
rowPosition = rowPosition + 1
Loop
cust_ID = txtC_IDCR.Text
Sheets("Customer Return").Cells(rowPosition, 1).Value = cust_ID
prod_Code = cbP_CodeCR.Text
Sheets("Customer Return").Cells(rowPosition, 2).Value = prod_Code
arr_date = txtA_DateCR.Text
Sheets("Customer Return").Cells(rowPosition, 3).Value = arr_date
If ((arr_date - Date) <= 0) Then
Sheets("Customer Return").Cells(rowPosition, 4).Value = "Arrived"
Else
Sheets("Customer Return").Cells(rowPosition, 4).Value = "Waiting for Delivery"
End If

End Sub

Sub Recalc()

Range("C:C").Value = Format("dd/mm/yyyy")
Range("D:D").Calculate

Call StartTime

End Sub

Sub StartTime()

SchedRecalc = Now + TimeValue("00:00:10")
Application.OnTime SchedRecalc, "Recalc"

End Sub

Sub EndTime()

On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, _
        Procedure:="Recalc", Schedule:=False

End Sub


Private Sub txtA_DateCR_AfterUpdate()

    With txtA_DateCR
    If .Text = "" Then
    .ForeColor = &HC0C0C0
    .Text = "dd/mm/yyyy"
    End If
    End With

End Sub

Private Sub txtA_DateCR_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Exit Sub
    If Mid(txtA_DateCR.Value, 4, 2) > 12 Then
        MsgBox "Invalid date, make sure format is (dd/mm/yyyy)", vbCritical
        txtA_DateCR.Value = vbNullString
        txtA_DateCR.SetFocus
        Exit Sub
    End If

    dDate = DateSerial(Year(Date), Month(Date), Day(Date))
    txtA_DateCR.Value = Format(txtA_DateCR.Value, "dd/mm/yyyy")
    dDate = txtA_DateCR.Value
End Sub

Private Sub txtA_DateCR_Enter()

    With txtA_DateCR
    If .Text = "dd/mm/yyyy" Then
    .ForeColor = &H80000008
    .Text = ""
    End If
    End With

End Sub

Private Sub UserForm_Initialize()

txtA_DateCR.ForeColor = &HC0C0C0
txtA_DateCR.Text = "dd/mm/yyyy"
cmdEnter.SetFocus

Fill_My_Combo Me.cbP_CodeCR

End Sub

Deeply appreciate any help if possible.

Answer 1

This should work in the most common scenario when time flows forward:

1. Create a utility module AnyNameIsGood with this code (it comes from Sean Cheshire's answer to similar question with the Recalc body adjusted)

   Dim ScheduledRecalc As Date
   
   Sub Recalc()
       Sheets("Customer Return").Range("D:D").Calculate
       Call StartTime
   End Sub
   
   Sub StartTime()
       ScheduledRecalc = Now + TimeValue("00:00:10")
       Application.OnTime ScheduledRecalc, "Recalc"
   End Sub
   
   Sub EndTime()
       On Error Resume Next
       Application.OnTime EarliestTime:=ScheduledRecalc, Procedure:="Recalc", Schedule:=False
   End Sub
   

2. Add this code to the ThisWorkbook module to prevent unwanted behavior while closing the module:

   Private Sub Workbook_BeforeClose(Cancel As Boolean)
       Call EndTime
   End Sub
   

3. In the CustomerReturn module (the form) change your current code to

   Private Sub cmdEnter_Click()
       ' ...
       arr_date = txtA_DateCR.Text
       Sheets("Customer Return").Cells(rowPosition, 3).Value = arr_date
       Sheets("Customer Return").Cells(rowPosition, 3).NumberFormat = "dd\/mm\/yyyy"
       Sheets("Customer Return").Cells(rowPosition, 4).FormulaR1C1 = "=IF(DAYS(R[0]C[-1],TODAY())<=0,""Arrived"",""Waiting for Delivery"")"
   End Sub
   

   It will format the date cells and it will make the generated Status formulas sensitive to the Excel's Calculate Now (F9) event.

4. Somewhere (e.g. in the Workbook_Open event handler) call the StartTime utility procedure (once). It will trigger automatic recalculation of the Status column.

Steps 1, 2, 4 are optional and not needed if the refresh does not have to be automatic as the end user can refresh the statuses anytime by pressing F9