Save Previous Cell Value Of A Changed Cell In Excel

Copper 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

31 Replies

@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.

@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.

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

@Rajesh_Sinha 

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?

@NikolinoDE 

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

@Shelbie1288 I think that should be:

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

@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!

@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 ...

@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!!!!

@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

 

@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!

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

@Shelbie1288 @mtarler  @Rajesh_Sinha Would be so kind to update the code with this feature (value of formula not formual)? Also do you know how is it possible to trigger the event with any kind of cell change ?

 

In my case what I want to accomplish is maintain a log of all the changes, I update cells in column E with a formula and then I want to maintain the old values in columns F, G, H and so on...

fadomas313_0-1608805241727.png

 

And something last, my first 5 rows are headers, is there a way to apply any code starting from row 6?

 

Many thanks to you all guys for sharing your stardust with us!

 

And something last, my first 5 rows are headers, is there a way to apply any code starting from row 6?

 

@fadomas313 again, untested, but I included this ability into the code.  If you look at my comment on the lines near the top:

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

Those should actually be ranges so you should be able to do something like this:

Const xSource = "E6:Z1000"  'This is a list of columns that need to be saved
Const xTarget = "F6:AA1000"  'This is a matching list of columns where to save

 as for any kind of cell change I don't understand what you mean.

That all said, there is a track changes feature in excel.  This is a legacy command and can show you changes in another sheet or as comments.  Here is a webinar I bought (actually my employed bought) and watched but I'm sure there are others:

https://www.complianceiq.com/trainings/livewebinar/3707/excel-spreadsheets-ensuring-data-integrity-a... 

 

 

If track changes is not a viable option, have you considered storing the previous value in a cell comment instead? A cell comment would always be tied to the cell and would not need to be constantly refreshed with each selection_change as the dictionary does in order to keep the last value synced to it's particular cell. If you still wanted the last value to appear in another cell, you could transfer the value stored in the cell comment to the other cell - it appears you're only keeping one level of previous values?

@fadomas313 

 

If track changes is not a good option and if using cell comments to store the current cell value is acceptable, you could take a look at the attached workbook. The code is in the sheet1 module and the thisworkbook module.

 

@JMB17 Many thanks!!!! This is exactly what I need!  Only thing is that the input is not manual but it´s related to another cell which is located to a different worksheet. To be precise I use this worksheet to concentrate data from another 3-4 worksheets. Do you know how can I trigger the event like this? 

 

Also Do you know how can I start inserting the "history" data at the column G and after?

 

Many thanks again, incredible!!! :D

@fadomas313 

 

There is a worksheet calculate event that can be used. But, you have to go through every cell in your range (Column E) to see which ones changed (excel passes the range that changed to the change event, but the calculate event won't know which cells were recalculated), so there could be some lag issues if you have a lot of cells to go through.

 

See attached.

@JMB17  Thank you for your reply, you think that if I would create a column right next to E would be easier to monitor them?
Let´s say link data from E7:E49 (this is where the data are gathering from the other worksheets) to F7:F49?