Save Previous Cell Value Of A Changed Cell In Excel

%3CLINGO-SUB%20id%3D%22lingo-sub-1816987%22%20slang%3D%22en-US%22%3ESave%20Previous%20Cell%20Value%20Of%20A%20Changed%20Cell%20In%20Excel%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1816987%22%20slang%3D%22en-US%22%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20am%20trying%20to%20save%20the%20values%20of%20one%20column%20(G)%20to%20another%20(D)%20once%20I%20update%20it%20to%20a%20new%20value.%26nbsp%3B%20I%20have%20the%20code%20correct%2C%20however%20the%20cell%20I%20want%20to%20save%20contains%20a%20formula%20and%20it%20is%20uploading%20that%20to%20column%20D.%20I%20want%20to%20save%20the%20value%20of%20the%20formula%2C%20not%20the%20formula%20itself.%26nbsp%3B%20Is%20there%20a%20way%20to%20alter%20the%20VBA%20code%20below%20to%20do%20so%3F%20(or%20a%20whole%20new%20code%20in%20general!%20I'm%20not%20picky!)%20Thank%20you%20all%20SO%20MUCH%20in%20advance!!!!%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EDim%20xRg%20As%20Range%3CBR%20%2F%3EDim%20xChangeRg%20As%20Range%3CBR%20%2F%3EDim%20xDependRg%20As%20Range%3CBR%20%2F%3EDim%20xDic%20As%20New%20Dictionary%3CBR%20%2F%3EPrivate%20Sub%20Worksheet_Change(ByVal%20Target%20As%20Range)%3CBR%20%2F%3EDim%20I%20As%20Long%3CBR%20%2F%3EDim%20xCell%20As%20Range%3CBR%20%2F%3EDim%20xDCell%20As%20Range%3CBR%20%2F%3EDim%20xHeader%20As%20String%3CBR%20%2F%3EDim%20xCommText%20As%20String%3CBR%20%2F%3EOn%20Error%20Resume%20Next%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20False%3CBR%20%2F%3EApplication.EnableEvents%20%3D%20False%3CBR%20%2F%3ExHeader%20%3D%20%22Previous%20value%20%3A%22%3CBR%20%2F%3Ex%20%3D%20xDic.Keys%3CBR%20%2F%3EFor%20I%20%3D%200%20To%20UBound(xDic.Keys)%3CBR%20%2F%3ESet%20xCell%20%3D%20Range(xDic.Keys(I))%3CBR%20%2F%3ESet%20xDCell%20%3D%20Cells(xCell.Row%2C%204)%3CBR%20%2F%3ExDCell.Value%20%3D%20%22%22%3CBR%20%2F%3ExDCell.Value%20%3D%20xDic.Items(I)%3CBR%20%2F%3ENext%3CBR%20%2F%3EApplication.EnableEvents%20%3D%20True%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20True%3CBR%20%2F%3EEnd%20Sub%3CBR%20%2F%3EPrivate%20Sub%20Worksheet_SelectionChange(ByVal%20Target%20As%20Range)%3CBR%20%2F%3EDim%20I%2C%20J%20As%20Long%3CBR%20%2F%3EDim%20xRgArea%20As%20Range%3CBR%20%2F%3EOn%20Error%20GoTo%20Label1%3CBR%20%2F%3EIf%20Target.Count%20%26gt%3B%201%20Then%20Exit%20Sub%3CBR%20%2F%3EApplication.EnableEvents%20%3D%20False%3CBR%20%2F%3ESet%20xDependRg%20%3D%20Target.Dependents%3CBR%20%2F%3EIf%20xDependRg%20Is%20Nothing%20Then%20GoTo%20Label1%3CBR%20%2F%3EIf%20Not%20xDependRg%20Is%20Nothing%20Then%3CBR%20%2F%3ESet%20xDependRg%20%3D%20Intersect(xDependRg%2C%20Range(%22G%3AG%22))%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3ELabel1%3A%3CBR%20%2F%3ESet%20xRg%20%3D%20Intersect(Target%2C%20Range(%22G%3AG%22))%3CBR%20%2F%3EIf%20(Not%20xRg%20Is%20Nothing)%20And%20(Not%20xDependRg%20Is%20Nothing)%20Then%3CBR%20%2F%3ESet%20xChangeRg%20%3D%20Union(xRg%2C%20xDependRg)%3CBR%20%2F%3EElseIf%20(xRg%20Is%20Nothing)%20And%20(Not%20xDependRg%20Is%20Nothing)%20Then%3CBR%20%2F%3ESet%20xChangeRg%20%3D%20xDependRg%3CBR%20%2F%3EElseIf%20(Not%20xRg%20Is%20Nothing)%20And%20(xDependRg%20Is%20Nothing)%20Then%3CBR%20%2F%3ESet%20xChangeRg%20%3D%20xRg%3CBR%20%2F%3EElse%3CBR%20%2F%3EApplication.EnableEvents%20%3D%20True%3CBR%20%2F%3EExit%20Sub%3CBR%20%2F%3EEnd%20If%3CBR%20%2F%3ExDic.RemoveAll%3CBR%20%2F%3EFor%20I%20%3D%201%20To%20xChangeRg.Areas.Count%3CBR%20%2F%3ESet%20xRgArea%20%3D%20xChangeRg.Areas(I)%3CBR%20%2F%3EFor%20J%20%3D%201%20To%20xRgArea.Count%3CBR%20%2F%3ExDic.Add%20xRgArea(J).Address%2C%20xRgArea(J).Formula%3CBR%20%2F%3ENext%3CBR%20%2F%3ENext%3CBR%20%2F%3ESet%20xChangeRg%20%3D%20Nothing%3CBR%20%2F%3ESet%20xRg%20%3D%20Nothing%3CBR%20%2F%3ESet%20xDependRg%20%3D%20Nothing%3CBR%20%2F%3EApplication.EnableEvents%20%3D%20True%3CBR%20%2F%3EEnd%20Sub%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1816987%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EFormulas%20and%20Functions%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1817491%22%20slang%3D%22en-US%22%3ERe%3A%20Save%20Previous%20Cell%20Value%20Of%20A%20Changed%20Cell%20In%20Excel%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1817491%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F845459%22%20target%3D%22_blank%22%3E%40Shelbie1288%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou%20need%20to%20rewrite%20this%20only%3A%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3ExDCell.Value%20%3D%20xDic.Items(I)%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ELike%20this%3A%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3ExDCell.Formula%20%3D%20xDic.Items(I)%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CEM%3EOr%20for%20better%20management%20you%20may%20use%20this%20macro%2C%20it's%20on%20click%20solution%3A%3C%2FEM%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3ESub%20FormulasToValuesInSelection()%0A%0A%20%20%20%20Dim%20rng%20As%20Range%0A%0A%20%20%20%20For%20Each%20rng%20In%20Selection%0A%0A%20%20%20%20%20%20%20%20If%20rng.HasFormula%20Then%0A%0A%20%20%20%20%20%20%20%20%20%20%20%20rng.Formula%20%3D%20rng.Value%0A%0A%20%20%20%20%20%20%20%20End%20If%0A%0A%20%20%20%20Next%20rng%0A%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CUL%3E%3CLI%3ESelect%20the%20Range%2C%20you%20want%20to%20convert%20into%20Value%2C%20then%20RUN%20the%20macro.%3C%2FLI%3E%3CLI%3EYou%20may%20use%20this%20VBA%20code%20with%20Command%20Button%20also.%3C%2FLI%3E%3C%2FUL%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1817515%22%20slang%3D%22de-DE%22%3ESubject%3A%20Save%20Previous%20Cell%20Value%20Of%20a%20Changed%20Cell%20in%20Excel%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1817515%22%20slang%3D%22de-DE%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F845459%22%20target%3D%22_blank%22%3E%40Shelbie1288%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EHere%20are%20two%20possible%20solutions%20that%20you%20could%20use%20in%20brief.%20The%20first%20is%20for%20the%20current%20cell.%20Even%20if%20several%20cells%20are%20selected%2C%20only%20the%20current%20cell%20is%20converted%3A%3C%2FP%3E%3CP%3ESub%20RngFormelZuValue%20()%20%3CBR%20%2F%3E%20Dim%20c%20As%20Range%20%3CBR%20%2F%3E%20For%20Each%20c%20In%20Selection%20%3CBR%20%2F%3E%20c.Value%20%3D%20c.Value%20%3CBR%20%2F%3E%20Next%20c%20%3CBR%20%2F%3E%20End%20Sub%3C%2FP%3E%3CP%3EYes%2C%20you%20can%20also%20do%20without%20the%20word%20value%2C%20because%20in%20this%20case%20it%20is%20the%20default%20property.%20But%20better%20safe%20than%20sorry%2C%20and%20this%20is%20how%20it%20will%20work%2010%20years%20from%20now.%3C%2FP%3E%3CP%3EThe%20second%20possibility%20would%20be%20that%20all%20cells%20in%20a%20marked%20area%20should%20be%20%22treated%22%20in%20this%20way.%20Then%20this%20code%20leads%20to%20the%20goal%3A%3C%2FP%3E%3CP%3ESub%20RngFormelZuValue%20()%20%3CBR%20%2F%3E%20Dim%20c%20As%20Range%20%3CBR%20%2F%3E%20For%20Each%20c%20In%20Selection%20%3CBR%20%2F%3E%20c.Value%20%3D%20c.Value%20%3CBR%20%2F%3E%20Next%20c%20%3CBR%20%2F%3E%20End%20Sub%3C%2FP%3E%3CP%3EYou%20can%20see%20that%20this%20is%20hardly%20more%20code%20than%20in%20the%20first%20example.%3CBR%20%2F%3EIs%20for%20everyone%20who%20would%20like%20to%20have%20it%20short%20and%20sweet%3A%3C%2FP%3E%3CP%3ESub%20Sel2Val%20()%20%3CBR%20%2F%3E%20Selection.Value%20%3D%20Selection.Value%20%3CBR%20%2F%3E%20End%20Sub%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20hope%20that%20I%20was%20able%20to%20help%20you%20further%2C%20or%20to%20provide%20a%20solution.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20would%20be%20happy%20to%20know%20if%20I%20could%20help.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ENikolino%3C%2FP%3E%3CP%3EI%20know%20I%20don't%20know%20anything%20(Socrates)%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E*%20Kindly%20Mark%20and%20Vote%20this%20reply%20if%20it%20helps%20please%2C%20as%20it%20will%20be%20beneficial%20to%20more%20community%20members%20reading%20here.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1820539%22%20slang%3D%22en-US%22%3ERe%3A%20Save%20Previous%20Cell%20Value%20Of%20A%20Changed%20Cell%20In%20Excel%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1820539%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F93699%22%20target%3D%22_blank%22%3E%40Rajesh-S%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3Ethank%20you%20very%20much%20for%20the%20help!%20I%20have%20tried%20the%20fix%20you%20suggested%20of%20changing%20the%20incorrect%20code%20to%20%3A%3C%2FP%3E%3CPRE%3ExDCell.Formula%20%3D%20xDic.Items(I).Value%3C%2FPRE%3E%3CP%3Ehowever%20the%20code%20will%20now%20not%20produce%20the%20previous%20cell%20anymore.%26nbsp%3B%20no%20errors%20were%20given%2C%20but%20the%20code%20does%20not%20produce%20anything.%26nbsp%3B%20any%20suggestions%3F%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1820596%22%20slang%3D%22en-US%22%3EBetreff%3A%20Save%20Previous%20Cell%20Value%20Of%20A%20Changed%20Cell%20In%20Excel%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1820596%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F722750%22%20target%3D%22_blank%22%3E%40Nikolino%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThank%20you%20for%20the%20reply!%26nbsp%3B%20I%20do%20not%20know%20how%20to%20write%20vba%20code%20at%20all%20so%20all%20I%20do%20is%20copy%20and%20paste%20what%20is%20given%20to%20me.%26nbsp%3B%20I%20have%20done%20so%20with%20the%20code%20you%20provided%20and%20nothing%20happened.%26nbsp%3B%20I%20am%20trying%20to%20have%20column%20D%20record%20the%20previous%20value%20(NOT%20formula)%20of%20Column%20G.%26nbsp%3B%20could%20you%20tell%20me%20what%20to%20change%20to%20your%20code%20written%20to%20do%20so%3F%20again%20thank%20you%20so%20so%20much%20for%20the%20help!%20I%20greatly%20appreciate%20it%3C%2FP%3E%3C%2FLINGO-BODY%3E
Highlighted
Occasional Contributor

 

I am trying to save the values of one column (G) to another (D) once I update it to a new value.  I have the code correct, however the cell I want to save contains a formula and it is uploading that to column D. I want to save the value of the formula, not the formula itself.  Is there a way to alter the VBA code below to do so? (or a whole new code in general! I'm not picky!) Thank you all SO MUCH in advance!!!!

 

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, 4)
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("G:G"))
End If
Label1:
Set xRg = Intersect(Target, Range("G:G"))
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

11 Replies
Highlighted

@Shelbie1288 

 

You need to rewrite this only: 

 

xDCell.Value = xDic.Items(I)

 

 

Like this:

 

xDCell.Formula = xDic.Items(I).Value

 

 

Or for better management you may use this macro, it's on click solution:

 

 

Sub FormulasToValuesInSelection()

    Dim rng As Range

    For Each rng In Selection

        If rng.HasFormula Then

            rng.Formula = rng.Value

        End If

    Next rng

End Sub

 

 

  • Select the Range, you want to convert into Value, then RUN the macro.
  • You may use this VBA code with Command Button also.
Highlighted

@Shelbie1288 

Here are two possible solutions that you could use in brief. The first is for the current cell. Even if several cells are selected, only the current cell is converted:

Sub RngFormelZuWert ()
Dim c As Range
For Each c In Selection
c.Value = c.Value
Next c
End Sub

Yes, you can also do without the word Value, because in this case it is the default property. But better safe than sorry, and this is how it will work 10 years from now.

The second possibility would be that all cells in a marked area should be "treated" in this way. Then this code leads to the goal:

Sub RngFormelZuWert ()
Dim c As Range
For Each c In Selection
c.Value = c.Value
Next c
End Sub

You can see that this is hardly more code than in the first example.
Is for everyone who would like to have it short and sweet:

Sub Sel2Val ()
Selection.Value = Selection.Value
End Sub

 

I hope that I was able to help you further, or to provide a solution.

 

I would be happy to know if I could help.

 

Nikolino

I know I don't know anything (Socrates)

 

* Kindly Mark and Vote this reply if it helps please, as it will be beneficial to more Community members reading here.

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Highlighted

@Rajesh-S 

thank you very much for the help! I have tried the fix you suggested of changing the incorrect code to :

xDCell.Formula = xDic.Items(I).Value

however the code will now not produce the previous cell anymore.  no errors were given, but the code does not produce anything.  any suggestions?

Highlighted

@Nikolino 

Thank you for the reply!  I do not know how to write vba code at all so all I do is copy and paste what is given to me.  I have done so with the code you provided and nothing happened.  I am trying to have column D record the previous value (NOT formula) of Column G.  could you tell me what to change to your code written to do so? again thank you so so much for the help! I greatly appreciate it

Highlighted

@Shelbie1288 I think that should be:

xDCell.Value = xDic.Items(I).Value
Highlighted

@mtarler 

Thank you for the reply! when I do that, it forces the cell that should contain the previous value to be blank.  The code is not working and if I try to type something into that value it makes it blank.  any suggestions? Thanks again!

Highlighted

@Shelbie1288 OK so I actually looked at the code and I think I know what is going on.  I don't have Dictionary type in my Excel (maybe this was an add-in or defined in another sheet of you book) but I think I get it.  Try returning that line back to the original:

xDCell.Value = xDic.Items(I)

 

and down much lower change this line:

xDic.Add xRgArea(J).Address, xRgArea(J).Formula

to 

xDic.Add xRgArea(J).Address, xRgArea(J).Value

 

crossing my fingers ...

Highlighted

@mtarler 

OH MY GOSH IT WORKED!!!!! I love you so much thank you thank you!!!!!!!

I do have one more tiiiiny question if you do not mind since you are an Excel Wizard!

 

So I am doing this with columns G and D, if I wanted to this for columns L and H simultaneously as well....how would one go about that? Then I promise I will not ask any more questions!!! Again I cannot thank all of you enough for the help!!!!

Highlighted

@Shelbie1288  OK, I can't test this because I don't have that dictionary definition but you can try this and not to be skeptical of my skills but it might be a miracle if it works first try (crossing my fingers):

Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Const xSource = "G:G, L:L"  'This is a list of columns that need to be saved
Const xTarget = "D:D, H:H"  'This is a matching list of columns where to save

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim I,J,xCol 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))
    For J = 1 To Range(xSource).Areas.Count
      If Not Intersect(xCell,Range(xSource).Areas(J)) Is Nothing Then
        xCol = Range(xTarget).Areas(J).Column
      End If
    Next J
    Set xDCell = Cells(xCell.Row, xCol)
    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(xSource))
  End If
Label1:
  Set xRg = Intersect(Target, Range(xSource))
  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).Value
    Next
  Next
  Set xChangeRg = Nothing
  Set xRg = Nothing
  Set xDependRg = Nothing
  Application.EnableEvents = True
End Sub

 

Highlighted

@mtarler 

IT IS NOT A MIRACLE YOU ARE AMAZING!!!!

It worked perfectly! I could cry, thank you again so so much!!!!!!

Don't sell yourself short! you are fantastic!

Highlighted
This address your issue,,, "save the value of the formula, not the formula itself.",,, I've suggested one more Macro "Sub FormulasToValuesInSelection()",, you may use it after you finish with Worksheet Change event Macro,, on the range you are getting New value (Formula).