Application.EnableEvents =

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d0 As Range, d As Range
    Application.ScreenUpdating = 0 'обновление экрана
    Application.Calculation = 3 'автопересчет формул
    Application.EnableEvents = 0 'события Excel
    Set d0 = Intersect(Target, Range("C3:C7")) 'пересечение измененных ячеек и диапазона. ОДИН раз
    If Not d0 Is Nothing Then 'если оно есть
        For Each d In d0 'пробегаемся по егойным ячейкам
            With d 'для каждой из них
                If .Value <> "" Then 'если она не пустая (нужно ли - не знаю)
                    .Offset(0, 1) = Date 'в соседнюю справа ставим дату
                End If
            End With
        Next d
        Columns(4).EntireColumn.AutoFit 'изменяем ширину столбца. ОДИН раз
    End If
    Application.EnableEvents = 1
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub