VBA code to insert date anytime the value in a cell changes.

[luzikedy]

For the moment my code add date to B2 anytime the Value in A2 changes.

The code looks like this:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim VRange As Range, cell As Range
Dim Msg As String
Dim ValidateCode As Variant
Set VRange = Range("A2:A10")
For Each cell In Target
If Union(cell, VRange).Address = VRange.Address Then
cell.Offset(, 2) = Date & " " & Time
End If
Next cell
End Sub

Here is what I need to add to the code:

Anytime the value in A2 changes - Current date is added to the cell, but to the next empty cell in the same row, so at the end I will have all dates when the value was changed.

Thank you in advance!

 

[skorpionkz]

try this

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim VRange As Range, cell As Range
Dim Msg As String
Dim ValidateCode As Variant
Dim iOff As Integer
Set VRange = Range("A2:A10")
For Each cell In Target
If Union(cell, VRange).Address = VRange.Address Then
iOff = cell.End(xlRight).Column - cell.Column+1
cell.Offset(, iOff) = Date & " " & Time
End If
Next cell
End Sub

 

[luzikedy]

Cześć,

Thx for answering, I just replaced my code with you code. but it doesn't work vba editor underlines "iOff = cell.End(xlRight).Column - cell.Column + 1"

and gives an error "Method 'End' of object 'Range failed.

 

[MARK858]

Try the code below (but you do realise that the code (this one and your original one works on A2 to A10 not just A2)).

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim VRange As Range, cell As Range
    Dim Msg As String
    Dim ValidateCode As Variant
    Set VRange = Range("A2:A10")
    For Each cell In Target
        If Union(cell, VRange).Address = VRange.Address Then
            Cells(cell.Row, Columns.Count).End(xlToLeft).Offset(, 1) = Date & " " & Time
        End If
    Next cell
End Sub

 

[luzikedy]

Yes, yes I do realise I work with the range. I just wanted to make it simpler to explain in words.

What you now wrote works great thx!

I don't need it now, but I know I will need in the other project, if possible and if it's ok to the forum rules please add the option of the offset to move the first cell with the date.

If I change a value in range A2:A10 - First date of change appears in column D.

Thx in advance!

 

[MARK858]

please add the option of the offset to move the first cell with the date.

If I change a value in range A2:A10 - First date of change appears in column D

I'm not clear what you are asking for here. If you are putting the date in a fixed column it is just

Cells(cell.Row, "D")

or

Cells(cell.row,4)

.

What you mean by

add the option of the offset to move the first cell with the date

I haven't a clue, the code finds your last row which isn't blank (by isn't blank if you have formula "" strings they count as not blank and we need to use another method if that is the case).

The offset just moves it 1 column.

 

[luzikedy]

I meant that the date shows in the column I specify, not just the first empty cell in a row.

Example:

Change in a Cell A1; B1:C1 are empty and stays empty;Date appears in D1;next change in Cell A1;Another date appears in E1

I hope is it clear now, thx for help anyway

I just noticed that the code I had and the one you provided stores the date&time as a string and I need it as an integer, so I could apply MAX formula that will return the newest date in a row.

Thx

 

[MARK858]

Change the date format to suit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim VRange As Range, cell As Range, i As Range
    
    Set VRange = Range("A2:A10")
    
    For Each cell In Target
        If Union(cell, VRange).Address = VRange.Address Then
        
        If IsEmpty(Cells(cell.Row, "D")) Then
        Cells(cell.Row, "D") = CLng(Date) + CDbl(Time)
        Cells(cell.Row, "D").NumberFormat = "m/d/yyyy h:mm"
        
        Else
        
            Set i = Cells(cell.Row, Columns.Count).End(xlToLeft).Offset(, 1)
            i.Value = CLng(Date) + CDbl(Time)
            i.NumberFormat = "m/d/yyyy h:mm"
        
        End If
        End If
    
    Next cell
End Sub

 

[luzikedy]

Works like a charm! Big big big thank you!