макрос проставления даты

[Сергей Ш.]

Уважаемые знатоки!
Помогите, пожалуйста, разобраться с макросом.
Макрос проставляет дату когда ячейка заполнена и удаляет дату когда ячейка пуста. Мне же необходимо, что бы дата удалялась, только при внесении конкретного значения, к примеру "Отправлен", а в остальных случаях дата проставлялась.
Для примера вложил файл

Макрос

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("A1:A100")) Is Nothing Then  'если измененная ячейка попадает в диапазон
            If IsEmpty(cell) Then
                cell.Offset(, 1) = Empty
            ElseIf cell.Offset(, 1) = Empty Then
                cell.Offset(0, 1) = Date
            End If
       End If
    Next cell
End Sub

[IgorGO]

добавте несколько операторов

If IsEmpty(cell) or cell = "Отправлен" Then

[Сергей Ш.]

Получилось, только не совсем так, как планировалось.
Задумка такая, что бы при смене значения дата то проставлялась то удалялась.
К примеру, если поставить в ячейке значение "Принят", то дата поставится, а если поменять на значение "Отправлен", то дата удалится или наоборот.

Вот макрос с вашим добавлением, может что то я не правильно делаю

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    For Each cell In Target   
       If Not Intersect(cell, Range("A1:A100")) Is Nothing Then 
            If IsEmpty(cell) Then
                cell.Offset(, 1) = Empty
            ElseIf cell.Offset(, 1) = Empty Then
                cell.Offset(0, 1) = Date
            If IsEmpty(cell) Or cell = "Отправлен" Then
            cell.Offset(, 1) = Empty
            End If
       End If
    End If
   Next cell
End Sub

[IgorGO]

а так:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("A1:A100")) Is Nothing Then  'если измененная ячейка попадает в диапазон O2:O10000
            If IsEmpty(cell) Or Cells = "Отправлен" Then
              cell.Offset(0, 1) = Empty
            Else
              cell.Offset(0, 1) = Date
            End If
       End If
    Next cell
End Sub

[Сергей Ш.]

поставил ваш код, теперь выходит ошибка
Run-time error '7': Out of memory

[IgorGO]

а так:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    For Each cell In Target   'проходим по всем измененным ячейкам
       If Not Intersect(cell, Range("A1:A100")) Is Nothing Then  'если измененная ячейка попадает в диапазон O2:O10000
            application.enableevents = false
            If IsEmpty(cell) Or Cells = "Отправлен" Then
              cell.Offset(0, 1).clearcontents
            Else
              cell.Offset(0, 1) = Date
            End If
            application.enableevents = true
       End If
    Next cell
End Sub

[Сергей Ш.]

Та же ошибка и потом дата не ставится.
Посмотрите пожалуйста

[IgorGO]

тут опечатка у меня, извините не
If IsEmpty(cell) Or Cells = "Отправлен" Then
а
If IsEmpty(cell) Or Cell = "Отправлен" Then

[Сергей Ш.]

Спасибо Вам ) все получилось
Вы гений!!!