Forum Discussion
Excel VBA to Store Previous Cell Values
Hello, I have a column (A) with eight different text drop down options. I need a code that will allow me to track each time the drop down is changed to a different option. I want each change to ...
Shouler This code appears to work:
Option Explicit
Private selRng As Range
Private selPrevValue As Variant
Private Sub Worksheet_Activate()
If Target.Cells.Count = 1 Then
Set selRng = Selection
selPrevValue = selRng.Value2
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim selCurValue As Variant
On Error GoTo ErrLoc 'added to ensure events are always turned back on
If Target.Cells.Count = 1 Then
Application.EnableEvents = False
If selRng Is Nothing Then
Set selRng = Target
selCurValue = selRng.Value2
Application.Undo
selPrevValue = selRng.Value2
Target.Value = selCurValue
If selPrevValue <> selCurValue Then
Storeprevvalue selRng, selPrevValue
End If
Else
If selPrevValue <> Target.Value Then
Storeprevvalue selRng, selPrevValue
End If
selPrevValue = Target.Value2
Set selRng = Target
End If
End If
ErrLoc:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
Set selRng = Selection
selPrevValue = selRng.Value2
End If
End Sub
Sub Storeprevvalue(rng As Range, prevValue As Variant)
If Not IsEmpty(prevValue) Then
Me.Cells(rng.Row, Me.Columns.Count).End(xlToLeft).Offset(, 1).Value = prevValue
End If
End Sub
This is helpful and kind of works, but it records a change to every cell in that row, when I need it to track only the changes in the first cell. Is there a way to resolve this? Thanks.
Shouler Like this (fixed a small bug too):
Option Explicit Private selRng As Range Private selPrevValue As Variant Private Sub Worksheet_Activate() If Intersect(Me.Range("A:A"), Selection) Is Nothing Then Exit Sub If Selection.Cells.Count = 1 Then Set selRng = Selection selPrevValue = selRng.Value2 End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim selCurValue As Variant On Error GoTo ErrLoc 'added to ensure events are always turned back on If Intersect(Me.Range("A:A"), Target) Is Nothing Then Exit Sub If Target.Cells.Count = 1 Then Application.EnableEvents = False If selRng Is Nothing Then Set selRng = Target selCurValue = selRng.Value2 Application.Undo selPrevValue = selRng.Value2 Target.Value = selCurValue If selPrevValue <> selCurValue Then Storeprevvalue selRng, selPrevValue End If Else If selPrevValue <> Target.Value Then Storeprevvalue selRng, selPrevValue End If selPrevValue = Target.Value2 Set selRng = Target End If End If ErrLoc: Application.EnableEvents = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Me.Range("A:A"), Target) Is Nothing Then Exit Sub If Target.Cells.Count = 1 Then Set selRng = Selection selPrevValue = selRng.Value2 End If End Sub Sub Storeprevvalue(rng As Range, prevValue As Variant) If Not IsEmpty(prevValue) Then Me.Cells(rng.Row, Me.Columns.Count).End(xlToLeft).Offset(, 1).Value = prevValue End If End Sub
