How do I get the old value of a changed cell in Excel VBA?

[Bomino]

Hello,

I trying to build a little data base in a spreadsheet and updating the records at the same time with the following code:

Dim wsdb As Worksheet, wsentry As Worksheet
Dim Lr As Long, myNr As Long
Dim Team As Range, Name As Range, wght As Range
Dim hght As Range, adr As Range, phne As Range
Dim Chck As Long
Dim Resp As Integer
Dim x As Variant

Set wsdb = ThisWorkbook.Sheets("DB")
Set wsentry = ThisWorkbook.Sheets("DataEntry")

Lr = wsdb.Cells(Rows.Count, 1).End(xlUp).Row
myNr = Lr + 1

On Error GoTo Rpt
Chck = WorksheetFunction.CountIfs(wsdb.Range("Team"), wsentry.Range("B3"), wsdb.Range("Name"), wsentry.Range("B4"), wsdb.Range("wght"), wsentry.Range("B5"))
 
  If Chck > 0 Then
 
  Resp = MsgBox("Candidat already registered." & vbNewLine & "Would you like to saves changes?", vbYesNo)
 
        If Resp = vbNo Then Exit Sub ' if this option is selected I would like
                                    'the changed cells (B6,B7 and B8 on wsentry)
                                    ' to reurned their previous values
       
        If Resp = vbYes Then
              For x = 2 To Lr
                If wsdb.Cells(x, 1) = wsentry.Cells(3, 2) And wsdb.Cells(x, 2) = wsentry.Cells(4, 2) And wsdb.Cells(x, 3) = wsentry.Cells(5, 2) Then
                  With wsdb
                      .Cells(x, 4) = wsentry.Cells(6, 2)
                      .Cells(x, 5) = wsentry.Cells(7, 2)
                      .Cells(x, 6) = wsentry.Cells(8, 2)
                  End With
                End If
              Next
          End If
  End If
 
Rpt:
 
  With wsdb
      .Cells(myNr, 1) = wsentry.Cells(3, 2)
      .Cells(myNr, 2) = wsentry.Cells(4, 2)
      .Cells(myNr, 3) = wsentry.Cells(5, 2)
      .Cells(myNr, 4) = wsentry.Cells(6, 2)
      .Cells(myNr, 5) = wsentry.Cells(7, 2)
      .Cells(myNr, 6) = wsentry.Cells(8, 2)
      .Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
      End With
 
End Sub

Assuming this isn't too bad a way of coding this, how do I get back the value of the cells before the change when Resp=VbNo is selected? See commented section on my code.
Any help will be greatly appreciated!
Thanks.

 

[Somendra Misra]

Hi,

How about uploading a sample file and let us see what are your previous values and how the code is working.

Regards,

 

[Bomino]

Somendra,

Please find attached a sample file.
Thanks.

 

[Somendra Misra]

Somendra,

Please find attached a sample file.
Thanks.

What do you mean by previous values? What are those?

Regards,

 

[Bomino]

If a candidate is already registered , the previous values would be the values that were already in the data base in colums "D", "E", "F"; ie parent cells of cell(x,1), cell(x,2), cell(x,3).

I hope it make sense.
Thanks

 

[Luke M]

You would need to store the value of a cell cells into a variable before you make the change. There is no built-in object/method to get previous value.

Additionally, if you have a macro called by a Change event, or for something similar, you can do something like this:

newValue = Range("A2").Value
Application.Undo
oldValue = Range("A2").Value
Range("A2").Value = newValue

'Example output
MsgBox "Old value was: " & oldValue

 

[Luke M]

For your specific code question, my follow-up question would be to ask how long you want to give user the change to "undo"? If they can only undo right away, you could simply copy the values in D:F to some other cells off to the right possibly, and then copy back if needed. Or, store them in a global variable.

 

[Bomino]

Thanks Luke.M; I will give it a try and see if I can make it work.

 

[Bomino]

Luke.M,
I've implemented your idea and it works like a charm. Here is the code I came up with:

Sub Save()
Dim wsdb As Worksheet, wsentry As Worksheet
Dim Lr As Long, myNr As Long
Dim Team As Range, Name As Range, wght As Range
Dim hght As Range, adr As Range, phne As Range
Dim Chck As Long
Dim Resp As Integer
Dim x As Variant
Dim StatVal As String, PhnVal As String, AddrVal As String


Set wsdb = ThisWorkbook.Sheets("DB")
Set wsentry = ThisWorkbook.Sheets("DataEntry")
Lr = wsdb.Cells(Rows.Count, 1).End(xlUp).Row
myNr = Lr + 1
  For x = 2 To Lr
    If wsdb.Cells(x, 1) = wsentry.Cells(3, 2) And wsdb.Cells(x, 2) = wsentry.Cells(4, 2) And wsdb.Cells(x, 3) = wsentry.Cells(5, 2) Then
      StatVal = wsdb.Cells(x, 4)
      PhnVal = wsdb.Cells(x, 5)
      AddrVal = wsdb.Cells(x, 6)
    End If
  Next

On Error GoTo Rpt
Chck = WorksheetFunction.CountIfs(wsdb.Range("Team"), wsentry.Range("B3"), wsdb.Range("Name"), wsentry.Range("B4"), wsdb.Range("wght"), wsentry.Range("B5"))

  If Chck > 0 Then

  Resp = MsgBox("Candidat already registered." & vbNewLine & "Would you like to saves changes?", vbYesNo)

        If Resp = vbNo Then
          wsentry.Cells(6, 2) = StatVal
          wsentry.Cells(7, 2) = PhnVal
          wsentry.Cells(8, 2) = AddrVal
        End If
      
        If Resp = vbYes Then
              For x = 2 To Lr
                If wsdb.Cells(x, 1) = wsentry.Cells(3, 2) And wsdb.Cells(x, 2) = wsentry.Cells(4, 2) And wsdb.Cells(x, 3) = wsentry.Cells(5, 2) Then
                  With wsdb
                      .Cells(x, 4) = wsentry.Cells(6, 2)
                      .Cells(x, 5) = wsentry.Cells(7, 2)
                      .Cells(x, 6) = wsentry.Cells(8, 2)
                  End With
                End If
              Next
        End If
  End If

Rpt:

  With wsdb
      .Cells(myNr, 1) = wsentry.Cells(3, 2)
      .Cells(myNr, 2) = wsentry.Cells(4, 2)
      .Cells(myNr, 3) = wsentry.Cells(5, 2)
      .Cells(myNr, 4) = wsentry.Cells(6, 2)
      .Cells(myNr, 5) = wsentry.Cells(7, 2)
      .Cells(myNr, 6) = wsentry.Cells(8, 2)
      .Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
      End With

End Sub

Thanks a lot!!

 

[Somendra Misra]

Thanks @Luke M for backing up. That is the plus point of a forum which remain active around the clock around the globe.

Regards,