Storing Previous Cell Value in Historic List

[Ehringer1358]

This seems like a simple enough question, but have had some difficulty with it. I need to store a cells value as it changes in a historic list. If the value changes from (1-->12-->7-->9) in cell A1. I want it to show 1-Cell B3, 12-Cell B2, and 7-Cell B1. So as the value changes the oldest value gets moved lower and lower, displaying a historic list of values.

[Paul_Hossler]

In the worksheet's code module insert this




Option Explicit

Private Sub Worksheet_Activate()
OldValue = Me.Range("A1").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("B1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Value = OldValue
Application.EnableEvents = True
OldValue = Range("A1").Value
End Sub


and a standard module



Option Explicit
Public OldValue As Variant

[Ehringer1358]

This worked perfect thanks! If I wanted to reference the "changing value" in a different sheet, how would I change the current code to operate in the same way. Essentially, if I am making changes on sheet 1, the changes will be stored in sheet 2.




In the worksheet's code module insert this




Option Explicit

Private Sub Worksheet_Activate()
OldValue = Me.Range("A1").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub

Application.EnableEvents = False
Range("B1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Value = OldValue
Application.EnableEvents = True

OldValue = Range("A1").Value
End Sub




and a standard module



Option Explicit
Public OldValue As Variant

[mattreingold]

Add a sheet identifier before range, I.E.


Dim WSD As Worksheet

Set WSD = ActiveWorkbook.Worksheets("Sheet2")

WSD.Range("B1").Value = OldValue

Or wherever it is needed.

[Ehringer1358]

Thanks for the help but don't believe I am implementing it correctly. The sheet i am wanting to pull from is names "Current Status" and the sheet I want to write historical data to is "005"



Option Explicit

Private Sub Worksheet_Activate()
Dim WSD As Worksheet
Set WSD = ActiveWorkbook.Worksheets("Current Status")
WSD.Range("D2").Value = OldValue
OldValue = Me.Range("D2").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D2")) Is Nothing Then Exit Sub
Dim WSD As Worksheet
Set WSD = ActiveWorkbook.Worksheets("005")
WSD.Range("D2").Value = OldValue
Application.EnableEvents = False
Range("H2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H2").Value = OldValue
Application.EnableEvents = True
OldValue = Range("D2").Value
End Sub






Add a sheet identifier before range, I.E.


Dim WSD As Worksheet
Set WSD = ActiveWorkbook.Worksheets("Sheet2")
WSD.Range("B1").Value = OldValue

Or wherever it is needed.

[Paul_Hossler]

1. I added CODE tags to your post -- you can use the [#] icon to insert beginning and ending CODE tags and paste your macro between them

2. Maybe something like this



Option Explicit
Private Sub Worksheet_Activate()
OldValue = Me.Range("D2").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Worksheets("005").Range("H2").Insert Shift:=xlDown
Worksheets("005").Range("H2").Value = OldValue
Application.EnableEvents = True
OldValue = Range("D2").Value
End Sub

[Ehringer1358]

That is working exactly as I need it, now how can I stack the Subs in the code to reference multiple cells in each Sub on my Input sheet and Output sheets, Listed below is what i'm working with.


Option Explicit

Private Sub Worksheet_Activate()
OldValue = Me.Range("A2").Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Worksheets("005").Range("H2").Insert Shift:=xlDown
Worksheets("005").Range("H2").Value = OldValue
Application.EnableEvents = True
OldValue = Range("A2").Value
End Sub

Private Sub Worksheet_Activate2()
OldValue = Me.Range("A3").Value
End Sub

Private Sub Worksheet_Change2(ByVal Target As Range)
If Intersect(Target, Range("A3")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Worksheets("006").Range("H2").Insert Shift:=xlDown
Worksheets("006").Range("H2").Value = OldValue
Application.EnableEvents = True
OldValue = Range("A3").Value
End Sub

Private Sub Worksheet_Activate()
OldValue = Me.Range("A4").Value
End Sub

Private Sub Worksheet_Change3(ByVal Target As Range)
If Intersect(Target, Range("A4")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Worksheets("009").Range("H2").Insert Shift:=xlDown
Worksheets("009").Range("H2").Value = OldValue
Application.EnableEvents = True
OldValue = Range("A4").Value
End Sub

[Paul_Hossler]

I wasn't very clear about inserting CODE tags -- the [#] icon is on the command bar

22344




In CurrentStatus code module



Option Explicit
Private Sub Worksheet_Activate()
Dim i As Long
For i = LBound(OldValues) To UBound(OldValues)
OldValues(i) = Me.Cells(i, 1).Value ' = Range("$A$2").Value to Range("$A$100").Value
Next i
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range

Set r = Target.Cells(1, 1)

Select Case r.Address

Case "$A$2"
Application.EnableEvents = False
Worksheets("005").Range("H2").Insert Shift:=xlDown
Worksheets("005").Range("H2").Value = OldValues(r.Row)
Application.EnableEvents = True

OldValues(r.Row) = Me.Cells(r.Row, 1).Value ' = Range("$A$2").Value

Case "$A$3"
Application.EnableEvents = False
Worksheets("006").Range("H2").Insert Shift:=xlDown
Worksheets("006").Range("H2").Value = OldValues(r.Row)
Application.EnableEvents = True

OldValues(r.Row) = Me.Cells(r.Row, 1).Value ' = Range("$A$3").Value

Case "$A$4"
Application.EnableEvents = False
Worksheets("009").Range("H2").Insert Shift:=xlDown
Worksheets("009").Range("H2").Value = OldValues(r.Row)
Application.EnableEvents = True

OldValues(r.Row) = Me.Cells(r.Row, 1).Value ' = Range("$A$4").Value
End Select

End Sub



In standard module




Option Explicit
Public OldValues(2 To 100) As Variant