Excel VBA automatically updating columns (Date)

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.