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