gtd526
Well-known Member
- Joined
- Jul 30, 2013
- Messages
- 684
- Office Version
- 2019
- Platform
- Windows
Hello,
Im using the following code for Maintaining Previous Value. It works when I enter the New value Manually, but not when its updated via Vlookup.
How can it be done using a Formula for updating value?
Thank you.
Im using the following code for Maintaining Previous Value. It works when I enter the New value Manually, but not when its updated via Vlookup.
How can it be done using a Formula for updating value?
Thank you.
VBA Code:
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) 'where the change goes(column)
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("L9:L15")) 'where the change happens
End If
Label1:
Set xRg = Intersect(Target, Range("L9:L15")) 'where the change happens
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
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 'changed from Formula to Value, Value only works Manually
Next
Next
Set xChangeRg = Nothing
Set xRg = Nothing
Set xDependRg = Nothing
Application.EnableEvents = True
End Sub