Automatically update date only if cell value changes

zinvie

New Member
Joined
Jun 23, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi everyone,

I am doing a sales funnel, where I have a dropdown list of stages in column G, and any changes are reflected in column H in the form of a time stamp.
The problem I have is whenever someone clicks on the individual cell but did not make any changes (e.g. click on a cell titled "prospect", but choose "prospect" from the list), the date would automatically update itself.

View attachment 41442

How do I amend the following code so that there will only be a change in date if the value in the cell changes (e.g. from prospect to qualify)? Any advice?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("G:G"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

Osvaldo Palmeiro

Well-known Member
Joined
Feb 24, 2009
Messages
690
Office Version
  1. 365
Platform
  1. Windows
Hi. Please, try this.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim oldValue As String, newValue As String
  If Target.Count > 1 Then Exit Sub
  If Target.Column <> 7 Then Exit Sub
  If Target.Value = "" Then Cells(Target.Row, 1) = "": Exit Sub
  newValue = Target.Value
  Application.EnableEvents = False
  Application.Undo
  oldValue = Target.Value
  If newValue <> oldValue Then
   Cells(Target.Row, 1) = Now
   Cells(Target.Row, 1).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
  End If
  Target.Value = newValue
  Application.EnableEvents = True
End Sub
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,890
Office Version
  1. 365
Platform
  1. Windows
Try:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim v   As Variant: ReDim v(1) As Variant
    Dim oc  As Long: oc = 1
       
    If Target.CountLarge > 1 Then Exit Sub
       
    If Not Intersect(Target, [G:G]) Is Nothing Then
        
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        
        With Target
            v(1) = .Value
            Application.Undo
            v(0) = .Value
            .Value = v(1)
            If v(1) <> v(0) Then
                With .Offset(, oc)
                    .Value = Now
                    .NumberFormat = "dd-mm-yyyy, hh:mm:ss"
                End With
            End If
            Erase v
        End With
        
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
    
End Sub
 

zinvie

New Member
Joined
Jun 23, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows

JackDanIce, thank you! your code worked! I am so happy!


Osvaldo Palmeiro, I tried your code, but it didn't work though
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,890
Office Version
  1. 365
Platform
  1. Windows
Glad it's resolved :) thanks for the feedback
 

Forum statistics

Threads
1,141,768
Messages
5,708,411
Members
421,566
Latest member
7Nabisco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top