Save the Previous Value of a cell, not the formula

[gtd526]

Hello,
I have a Private Sub that retains the Previous Value of a changed cell. It works correctly if I change the cell value manually.
But it copies the Formula in the changed cell. How can I retain the Value not the Formula within a changed cell value?
L:L = value that changes.
N:N(14) = retains previous value
Thank you.

Here is the data:

The Whole Enchilada.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
8	Symbol	Sector	Type	Shares	Cost	CURRENT	MAX Value	MIN Value	Cost Value	Market Value	Gain/Loss	G/L %	Weight(%)	Prev Value
9	PRCOX	Lg Growth	Long	1627.723	$ 41.631	$ 41.73	$ 52.00	$ 41.73	$ 67,763.74	$ 67,924.88	$ 161.14	0.24%	58.0%	0.24%
10	RMQHX	2x	Long	45.177	$ 426.476	$ 446.43	$ 550.00	$ 446.43	$ 20,139.59	$ 20,168.37	$ 28.78	0.14%	17.2%
11	RYTNX	2x	Long	87.584	$ 223.065	$ 223.59	$ 237.16	$ 223.59	$ 20,139.59	$ 19,582.91	$ (556.68)	-2.76%	17.2%
12	OAYMX	Lg Value	Long	83.751	$ 104.186	$ 109.17	$ 140.00	$ 109.17	$ 8,725.64	$ 9,143.10	$ 417.46	4.78%	7.5%
Schwab

Cell Formulas
Range	Formula
F9:F12	F9	=IFERROR(VLOOKUP($A9,$A$45:$B$49,2,0),"")
G9:G12	G9	=IFERROR(IF($F9=0,0,MAX($F9,$G9)),"")
H9:H12	H9	=IFERROR(IF($H9=0,$F9,MEDIAN($H9,$F9,0)),"")
I9	I9	=(E9*D9)
J9:J12	J9	=IFERROR($D9*$F9,"")
K9:K12	K9	=IFERROR(J9-I9,"")
L9:L12	L9	=IFERROR((K9/I9),"")
M9:M12	M9	=IF($I9<>0,I9/$J$16,"")
N9	N9	=IFERROR((K9/I9),"")
B9:B12	B9	=IF(COUNTIF(Sectors!$A$3:$AA$50,A9)=1,INDEX(Sectors!$A$2:$AA$2,MAX((Sectors!$A$3:$AA$50=A9)*(COLUMN(Sectors!$A$2:$AA$2)))),"")
Press CTRL+SHIFT+ENTER to enter array formulas.

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A9:E15	Expression	=MOD(ROW(),2)=1	text	NO
F9:F15	Expression	=$F9=$G9	text	NO
F9:F15,H9:H15	Expression	=$F9=$H9	text	NO
A9:A15	Expression	=$L9<0	text	NO
A9:A15	Expression	=$L9>0	text	NO
M9:O9,M11:O12,M10:N10,M15:O15,M13:N14	Expression	=$N9="sold"	text	NO
I9:M15	Expression	=MOD(ROW(),2)=1	text	NO
C9:C15	Cell Value	="put"	text	NO
C9:C15	Cell Value	="call"	text	NO
G9:G15	Expression	=$F9=$G9	text	NO
R21:R30,L14:L15,K9:L13	Cell Value	<0	text	NO
R21:R30,L14:L15,K9:L13	Cell Value	>0	text	NO
B12:B14,B9:B10	Expression	=#REF!=TODAY()+3	text	NO
B12:B14,B9:B10	Expression	=#REF!=TODAY()	text	NO
B12:B14,B9:B10	Expression	=#REF!=TODAY()+1	text	NO
B12:B14,B9:B10	Expression	=#REF!=TODAY()+2	text	NO
B12:B14,B9:B10	Expression	=#REF!="sold"	text	NO
B10	Expression	=#REF!=TODAY()+3	text	NO
B10	Expression	=#REF!=TODAY()	text	NO
B10	Expression	=#REF!=TODAY()+1	text	NO
B10	Expression	=#REF!=TODAY()+2	text	NO
B10	Expression	=#REF!="sold"	text	NO
B12:B14,B10	Expression	=$N51=TODAY()+3	text	NO
B12:B14,B10	Expression	=$N51=TODAY()	text	NO
B12:B14,B10	Expression	=$N51=TODAY()+1	text	NO
B12:B14,B10	Expression	=$N51=TODAY()+2	text	NO
B12:B14,B10	Expression	=$N51="sold"	text	NO
B9:B10	Expression	=$N52=TODAY()+3	text	NO
B9:B10	Expression	=$N52=TODAY()	text	NO
B9:B10	Expression	=$N52=TODAY()+1	text	NO
B9:B10	Expression	=$N52=TODAY()+2	text	NO
B9:B10	Expression	=$N52="sold"	text	NO
B11	Expression	=#REF!=TODAY()+3	text	NO
B11	Expression	=#REF!=TODAY()	text	NO
B11	Expression	=#REF!=TODAY()+1	text	NO
B11	Expression	=#REF!=TODAY()+2	text	NO
B11	Expression	=#REF!="sold"	text	NO

Here is the Code:

Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
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, 14)
        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("L:L"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("L:L"))
    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

 

[AshKot146]

In your VBA code change the section of code from:

    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

To

    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).Value
        Next
    Next

And you are good to Go!

 

[gtd526]

In your VBA code change the section of code from:

    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

To

    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).Value
        Next
    Next

And you are good to Go!

THANK YOU for the change.