Save Previous Cell Value Of A Changed Cell In Excel

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