Record Date values based on another cell's value - excel

Question

I am a beginner in VBA.
I have a Column "A" can have multiple values, of which 2 are "Impact Assessed" or "Ready for retesting".
Problem Statement - I want to record the dates when cell's value is changed to Impact Assessed and Ready for Retesting in 2 separate columns - Column B and Column C, respectively.
Below is my code -
Private Sub Worksheet_Calculate()
Dim rng As Range
If Target.CountLarge > 1 Then Exit Sub
Set rng = Application.Intersect(Me.Range("AA:AA"), Target)
If Not rng Is Nothing Then
Select Case (rng.Value)
Case "2 - Impact Assessed": rng.Offset(0, 1).Value = Date
Case "4 - Ready for retesting": rng.Offset(0, 2).Value = Date
End Select
End If
End Sub

Answer 1

I have made the code as versatile as possible. Just change the constants and, if need be, the search criteria in the Criteria variable to suit your worksheet and you can change your sheet as you like without needing to modify the code.
Private Sub Worksheet_Change(ByVal Target As Range)
' 040
Const TriggerClm As String = "A" ' change to suit
Const WriteToClm As String = "B" ' the second one is next to this
Dim Rng As Range ' working range
Dim C As Long ' WriteToClm
Dim Criteria() As String ' selected values from TriggerClm
Dim i As Integer ' index to Criteria()
' don't respond to changes of multiple cells such as Paste or Delete
If Target.CountLarge > 1 Then Exit Sub
' respond to changes in cells from row 2 to
' one cell below the last used row in the trigger column
Set Rng = Range(Cells(2, TriggerClm), _
Cells(Rows.Count, TriggerClm).End(xlUp).Offset(1))
If Not Application.Intersect(Rng, Target) Is Nothing Then
' intentionally all lower case because comparison
' is carried out case insensitive
' First item's date is in WriteToClm
Criteria = Split("impact assessed,ready for retesting", ",")
For i = UBound(Criteria) To 0 Step -1
If StrComp(Target.Value, Criteria(i), vbTextCompare) = 0 Then Exit For
Next i
' i = -1 if no match was found
If i >= 0 Then
C = Columns(WriteToClm).Column + i
Cells(Target.Row, C).Value = Date
End If
End If
End Sub

Answer 2

You can use something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range
'If Target.CountLarge > 1 Then Exit Sub
Set rng = Application.Intersect(Me.Range("A:A"), Target)
If Not rng Is Nothing Then
For Each c in rng.cells
Select Case LCase(c.Value)
Case "impact assessed": c.Offset(0, 1).Value = Date
Case "ready": c.Offset(0, 2).Value = Date
End Select
Next c
End If
End Sub
FYI = Range(Target.Address) is the same (in this case) as Target - no need to get the address just to turn that back into a range.