vbaexceldatestamp

Timestamp in Excel with very specific requirements


I need some help with an Excel vba code that can do the following. I'm a beginner VBA programmer at best, I just need something to work for a spreadsheet I'm working on.

I know there are countless questions and answers about timestamp codes and I've read a LOT of them, but I can't find one that's specific to my needs. I've spent hours looking, so that's why I'm asking instead. Here's what I need:

  1. When a cell in column A is changed and the corresponding cell in column B is blank, date stamp the cell in column B with the current date.

  2. Subsequently, if a cell in column A is changed and the corresponding cell in column B is not blank (because it already contains a date stamp from a previous change of column A), the date stamp in the cell in column B should not be changed. This includes if the cell in column A is replaced with the same value.

  3. If cell in column A is cleared, either on it's own or as part of a multi-cell select and clear contents, the date stamp in the cell in column B should not be changed OR removed.

  4. Only if the date stamp is cleared manually in the cell in column B, should it then be again date stamped with the current date if the value of the corresponding cell in column A is changed again (basically a reset).

  5. First row is labels, so do nothing to the cells in the first row.

I hope I've made this clear enough. If not, please let me know. Thanks in advance for any and all replies and I'm sorry if this was available somewhere and I just couldn't find it.


Solution

  • Try the following code. And give us some feedback, please!

    Since you may be applying a change to many cells simultaneously (eg. pressing Ctrl+Enter), I used a loop to navigate through each cell being changed.

    Private Sub Worksheet_Change(ByVal Target As Range)
        For Each cell In Target.Cells
            If cell.Row > 1 And cell.Column = 1 Then
                If cell.Offset(0, 1).Value = "" Then
                    cell.Offset(0, 1).Value = Now()
                End If
            End If
        Next
    End Sub