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

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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
 
Upvote 0
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
 
Upvote 0

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


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

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

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
Back
Top