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.