VBA to Store Previous Cell Value

welshraz

New Member
Joined
Apr 29, 2016
Messages
20
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):

VBA Code:
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.
 
Last edited by a moderator:

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,571
Office Version
  1. 2007
Platform
  1. Windows
but I want it to only track the changes from column A (starting at A3):
Try this:

VBA Code:
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

New Member
Joined
Apr 29, 2016
Messages
20
Try this:

VBA Code:
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:

1627042988480.png


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

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,571
Office Version
  1. 2007
Platform
  1. Windows
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
VBA Code:
Private Sub Worksheet_Activate()
    ActiveCell.Select
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,571
Office Version
  1. 2007
Platform
  1. Windows
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

VBA Code:
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
 
Solution

Forum statistics

Threads
1,141,043
Messages
5,703,917
Members
421,321
Latest member
blusky4

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
Top