Automatically show date when particular result detected from Excel formula - excel

Question

I am trying with VBA to get the current date on column H (Date).
In column F (Result)
If I manually type Preferred or Non-preferred.
After pressing Enter, today's date will be automatically put on column H (Date)
When I paste formula instead (which will consider data from column A-E to show result on its cell).
Even if the result gives Preferred or Non-preferred the date will not automatically show up.
Unless I press double-click and enter on each result cell then it will show up.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim St As String
St = "Preferred|Non-Preferred"
If Not Intersect(Columns("F"), Target) Is Nothing Then
Application.EnableEvents = False
For Each c In Intersect(Columns("F"), Target).Cells
If InStr(1, St, c.Value, vbTextCompare) >= 1 Then
Cells(c.Row, "H").Value = Date
Else
If IsEmpty(c) Then Cells(c.Row, "H").Value = ""
End If
Next c
Application.EnableEvents = True
End If
End Sub
Example

Answer 1

A Worksheet Change: Using Precedents
In column F is a formula that calculates dependent on the values of columns A:E (precedents). The code will trigger when the values in columns A:E are manually changed, possibly modifying the value in column H (see OP's description (requirements)).
The Select Case statement could be reduced to two cases: either it begins with Criteria (1) or it doesn't (Else).
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ClearError
Const sFirstCellAddress As String = "F2"
Const dCol As String = "H"
Const Criteria As String = "Preferred"
Dim srg As Range
With Me.Range(sFirstCellAddress)
Set srg = .Resize(Me.Rows.Count - .Row + 1)
End With
Dim irg As Range: Set irg = Intersect(srg.Precedents, Target)
If irg Is Nothing Then Exit Sub
Set srg = Intersect(irg.EntireRow, Columns(srg.Column))
Dim drg As Range: Set drg = srg.EntireRow.Columns(dCol)
Application.EnableEvents = False
Dim dCell As Range
Dim n As Long
For Each dCell In drg.Cells
n = n + 1
Select Case InStr(1, CStr(srg.Cells(n).Value), Criteria, vbTextCompare)
Case 0
dCell.Value = Empty ' criteria not found
Case 1
dCell.Value = Date ' begins with criteria
Case Else
dCell.Value = Empty ' contains criteria
End Select
Next dCell
SafeExit:
If Not Application.EnableEvents Then Application.EnableEvents = True
ProcExit:
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub