Как остановить код перезаписи ячеек со значениями в них

Question

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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Date
            Rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If

End Sub

Answer 1

Вы можете проверить, является ли значение уже датой

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("A:A"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            With Rng.Offset(0, xOffsetColumn)
                If Not VBA.Information.IsDate(.Value) Then
                    .Value = Date
                    .NumberFormat = "mm-dd-yyyy"
                End If
            End With
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If

End Sub