VBA to Store Previous Cell Value

[welshraz]

Afternoon,

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 tracks any change in any cell on the row, but I want it to only track the changes from column A (starting at A3):

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

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.

 

[DanteAmor]

but I want it to only track the changes from column A (starting at A3):

Try this:

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.CountLarge = 1 Then
      If Target.Column = 1 And Target.Row > 2 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
    End If
ErrLoc:
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge = 1 Then
      If Target.Column = 1 And Target.Row > 2 Then
        Set selRng = Selection
        selPrevValue = selRng.Value2
      End If
    End If
End Sub

Sub Storeprevvalue(rng As Range, prevValue As Variant)
  Dim xMax As Long
    If Not IsEmpty(prevValue) Then
      'Just make sure it starts in the AW column
      xMax = WorksheetFunction.Max(Range("AW1").Column, Cells(rng.Row, Columns.Count).End(1).Column + 1)
      Me.Cells(rng.Row, xMax).Value = prevValue
    End If
End Sub

 

[welshraz]

Try this:

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.CountLarge = 1 Then
      If Target.Column = 1 And Target.Row > 2 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
    End If
ErrLoc:
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge = 1 Then
      If Target.Column = 1 And Target.Row > 2 Then
        Set selRng = Selection
        selPrevValue = selRng.Value2
      End If
    End If
End Sub

Sub Storeprevvalue(rng As Range, prevValue As Variant)
  Dim xMax As Long
    If Not IsEmpty(prevValue) Then
      'Just make sure it starts in the AW column
      xMax = WorksheetFunction.Max(Range("AW1").Column, Cells(rng.Row, Columns.Count).End(1).Column + 1)
      Me.Cells(rng.Row, xMax).Value = prevValue
    End If
End Sub

Thank you so much, this is exactly what I was looking for. One small problem is that if I move to another tab and then back to the tab with this macro attached, I get this:

Ideally I would like to run the same code on several tabs in the worksheet.

 

[DanteAmor]

One small problem is that if I move to another tab and then back to the tab with this macro attached

Change to this:

Selects a single cell. With that the Worksheet_SelectionChange event does what is necessary

Private Sub Worksheet_Activate()
    ActiveCell.Select
End Sub

 

[DanteAmor]

Ideally I would like to run the same code on several tabs in the worksheet.

Delete the code you have from the sheet.
Put the following code in the ThisWorkbook events.
Update the name of the sheets in the CheckSheet function

Private selRng As Range
Private selPrevValue As Variant
  
Private Sub Workbook_SheetActivate(ByVal sh As Object)
  If CheckSheet(sh.Name) Then
    ActiveCell.Select
  End If
End Sub

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
  Dim selCurValue As Variant
  On Error GoTo ErrLoc    'added to ensure events are always turned back on
  If Target.CountLarge > 1 Then Exit Sub
  '
  If CheckSheet(sh.Name) Then
    If Target.Column = 1 And Target.Row > 2 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
  End If
ErrLoc:
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
  If Target.CountLarge > 1 Then Exit Sub
  '
  If CheckSheet(sh.Name) Then
    If Target.Column = 1 And Target.Row > 2 Then
      Set selRng = Selection
      selPrevValue = selRng.Value2
    End If
  End If
End Sub

Sub Storeprevvalue(rng As Range, prevValue As Variant)
  Dim xMax As Long
  If Not IsEmpty(prevValue) Then
    'Just make sure it starts in the AW column
    xMax = WorksheetFunction.Max(Range("AW1").Column, Cells(rng.Row, Columns.Count).End(1).Column + 1)
    Cells(rng.Row, xMax).Value = prevValue
  End If
End Sub

Function CheckSheet(MySheet As String) As Boolean
  Dim nSheets As Variant
  Dim i As Long
  nSheets = Array("Report", "Data") 'add the sheets in which you want to run the code
  For i = 0 To UBound(nSheets)
    If LCase(MySheet) = LCase(nSheets(i)) Then
      CheckSheet = True
      Exit Function
    End If
  Next
End Function