Заполните дату в определенном столбце и строке на основе значения ячейки

Я получил запрос на ввод даты на основе выбранного статуса (значение ячейки) в столбце, представляющем этот статус. Например, если я выбираю статус «Событие_1» в столбце А из раскрывающегося списка, макрос должен найти столбец с таким же именем (Событие_1) и указать дату в этом столбце для строки, в которой статус был изменен.

Я только заполнил соседнюю ячейку датой, когда указанная ячейка была изменена. Я знаю, что мне, вероятно, следует настроить смещение на номер столбца, представляющий мой статус, однако я не уверен, как этого добиться.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 Dim ColNum As Integer
 
 With Target
 If.Count > 1 Then Exit Sub
 If Not Intersect(Range("A:A"),.Cells) Is Nothing Then
 Application.EnableEvents = False
 If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
 Else
 With.Offset(0, 1)
 .NumberFormat = "dd mmm yyyy"
 .Value = Now
 End With
 End If
 Application.EnableEvents = True
 End If
 End With
End Sub

Решение проблемы

Как насчет этого?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ColNum As Integer
With Target
 If.Count > 1 Then Exit Sub
 If Not Intersect(Range("A:A"),.Cells) Is Nothing Then
 Application.EnableEvents = False
 If IsEmpty(.Value) Then
 '.Offset(0, 1).ClearContents
 'Why???
 Else
 ColNum = Application.WorksheetFunction.Match(Target.Value, Range("1:1"), 0)
 With.Offset(0, ColNum - 1)
.NumberFormat = "dd mmm yyyy"
.Value = Now
 End With
 End If
 Application.EnableEvents = True
 End If
End With
End Sub

Единственная часть, которую я не понимаю, это:

If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents

Почему? Вы должны указать, что вы хотите сделать, когда опция не выбрана.