Forum Discussion

Shouler's avatar
Shouler
Copper Contributor
Jul 15, 2021

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 ...
Macros and VBA
Shouler's avatar
Shouler
Copper Contributor
Jul 22, 2021

JKPieterse 

 

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.

JKPieterse's avatar
JKPieterse
Silver Contributor
Jul 23, 2021

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

Resources