Oct 25 2020 06:26 PM
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
Oct 26 2020 01:18 AM - edited Oct 26 2020 02:13 AM
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
Oct 26 2020 01:26 AM
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.
Oct 26 2020 01:24 PM
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?
Oct 26 2020 01:40 PM
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
Oct 26 2020 01:42 PM
@Shelbie1288 I think that should be:
xDCell.Value = xDic.Items(I).Value
Oct 26 2020 02:08 PM
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!
Oct 26 2020 02:32 PM
@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 ...
Oct 26 2020 02:56 PM
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!!!!
Oct 26 2020 04:23 PM
@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
Oct 26 2020 06:01 PM
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!
Oct 27 2020 02:04 AM
Dec 24 2020 02:27 AM - edited Dec 24 2020 03:08 AM
@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...
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!
Dec 24 2020 03:05 AM
And something last, my first 5 rows are headers, is there a way to apply any code starting from row 6?
Dec 24 2020 06:41 AM
@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:
Dec 25 2020 08:18 AM
Dec 25 2020 08:25 AM - edited Dec 25 2020 08:27 AM
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.
Dec 29 2020 08:06 AM
@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
Dec 29 2020 12:48 PM
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.
Dec 30 2020 12:09 AM
@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?