CODEWITHSUNDEEP
excelvba
CustomX
CustomX

Reputation: 10113

Excel VBA - Cell change, datestamp in a column

I want to create two date stamps, one for OK and one for NOT OK. The values are filled in in column A and are 'x' for OK and 'NOK' for NOT OK.

When 'x' is filled in in column A, the value in column 49 should be the datestamp when 'x' is filled in.

When 'NOK' is filled in in column, the value in column 52 should be the datestamp when 'NOK' is filled in.

Also, if 'x' or 'NOK' is removed from column A, so should the datestamp dissappear. This is what I have.

Private Sub Worksheet_Change(ByVal Target As Range)
    '49 = ok
    '52 = NOK

    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Set KeyCells = Range("A1:" & LastRow)

    If Application.Intersect(KeyCells, Range(Target.Address)) Like "*x*" Then
        Cells(Row, 49).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
    End If

    If Application.Intersect(KeyCells, Range(Target.Address)) Like "*NOK*" Then
        Cells(Row, 52).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
    End If

End Sub

Upvotes: 0

Views: 2268

Answers (1)

Jook
Jook

Reputation: 4692

Here, try this:

Private Sub Worksheet_Change(ByVal Target As Range)
    '49 = ok '52 = NOK
    Application.EnableEvents = False

    With Target
    'check if change happend in column A
    If .Column = 1 Then
      'check if changed value is X
      If .Value Like "*x*" Then
          'add datestamp if it is
          Cells(.Row, 49).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
      Else
          'clear datestamp if not
          Cells(.Row, 49).Value = ""
      End If

      If .Value Like "*NOK*" Then
          Cells(.Row, 52).Value = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")
      Else
          Cells(.Row, 52).Value = ""
      End If
    End If
    End With
    Application.EnableEvents = True
End Sub

Upvotes: 3

Related Questions