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 be tracked in a different cell so that I can see how each line has progressed - e.g. from Received to Query to Invalid etc.

 

I have the following code which works to remember the last value of the cell from column A, but I cannot figure out how to make it work for my needs:

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Dim xHeader As String
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Previous value :"
x = xDic.Keys
For I = 0 To UBound(xDic.Keys)
Set xCell = Range(xDic.Keys(I))
Set xDCell = Cells(xCell.Row, 49)
xDCell.Value = ""
xDCell.Value = xDic.Items(I)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
On Error GoTo Label1
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Set xDependRg = Target.Dependents
If xDependRg Is Nothing Then GoTo Label1
If Not xDependRg Is Nothing Then
Set xDependRg = Intersect(xDependRg, Range("A:A"))
End If
Label1:
Set xRg = Intersect(Target, Range("A:A"))
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
Set xChangeRg = xRg
Else
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
For I = 1 To xChangeRg.Areas.Count
Set xRgArea = xChangeRg.Areas(I)
For J = 1 To xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formula
Next
Next
Set xChangeRg = Nothing
Set xRg = Nothing
Set xDependRg = Nothing
Application.EnableEvents = True
End Sub

 

Essentially, I want every change made in column A tracked in column AW, AX, AY and so on.  There will be no more than 10 changes to an individual cell in column A.

 

Thanks.

Macros and VBA

3 Replies

  • JKPieterse's avatar
    JKPieterse
    Silver Contributor
    Jul 19, 2021

    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
    • 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