Copy Cell changes to a different sheet.

[XrayLemi]

Hope you all are healthy and safe.
Once again I am at your mercy.
I am trying to log changes to specific cells on a spreadsheet. The cells I am trying to log changes to have their attributes set to locked. When the changes are made the sheet will be password unprotected. I only want the code to change the cells whos properties are set to locked. These are the cells that should not be changed without approval. The remainder of the cells that can be changed are set to unlocked and can be changed at will until it is time to lock them. I don't want changes tracked to the unlocked cells. There are multiple spreadsheets all of which are identical.

The following code does not do anything. It should track the changes to whatever target cell is picked. Then it should copy the old and new values of the target cell to sheet 3. I get nothing. There are also no errors showing up at all. As changes are made, the next change should show on the next free line. Please understand I am by no means fluent in VBA. This is all copy, paste, and massage. I'm trying to at least give it a try before I post. I don't want you to do it all for me. I want to learn. Where did I go wrong?
Thanks,
Jim

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim NewValue, OldValue
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim CopyTargetValue
    Dim DestTargetValue
   If Target.Locked = False Then
   End If
 If Target.Locked = True Then
    Application.EnableEvents = False
    With Target
        NewValue = .Value
        Application.Undo
        OldValue = .Value
        .Value = NewValue
       End With
    Set wsDest = ThisWorkbook.Worksheets("Sheet3")
       CopyTargetValue = wsCopy.Target.NewValue
       DestTargetValue = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
       wsDest.Range("B" & DestTargetValue).Value = wsCopy.Target.OldValue
       wsDest.Range("C" & DestTargetValue).Value = wsCopy.Target.NewValue
     Application.EnableEvents = True
 End If
End Sub

 

[XrayLemi]

Ok,
I tried to massage the code a little. Here is the new code.

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
    Dim NewVal, OldVal
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim CopyTargetValue As Long
    Dim DestTargetValue As Long
    
    
 Dim f As Range, k As Range
    Set f = Range("A1:A5000")
    Set f = Intersect(Target, f)
    If Not f Is Nothing Then
      Application.EnableEvents = False
         If Cells(f.Row, "A").Locked = False Then
          End If
         If Cells(f.Row, "A").Locked = True Then
          Cells(f.Row, "A").Value = NewVal
          Application.Undo
          Cells(f.Row, "A").Value = OldVal
          Cells(f.Row, "A").Value = NewVal
         End If
    End If
    
    Set wsCopy = ThisWorkbook.ActiveSheet
    Set wsDest = ThisWorkbook.Worksheets("Sheet3")
      CopyTargetValue = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
      DestTargetValue = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
      wsDest.Range("B" & DestTargetValue).OldVal = wsCopy.Range("A" & CopyTargetValue).Value = OldVal
      wsDest.Range("C" & DestTargetValue).Value = NewVal
      wsDest.Activate
End Sub

At least now I get an error. It is in this line of the code.

 wsDest.Range("B" & DestTargetValue).OldVal = wsCopy.Range("A" & CopyTargetValue).Value = OldVal

I cannot for the life of me figure out what I am doing. I hope you can Help.
Thanks Again,
Jim

 

[Marc L]

​

Via the VBE Locals window check each variable content used in the codeline where the errors occurs …​

​

But as .OldVal does not exist in VBA on my side so a non sense ! Try Value instead …​

 

[XrayLemi]

Hi Marc,
This is the original code that I copied to start mine. (copied from a previous Mr. Excel post.)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim NewValue, OldValue
    If Target.Address <> "$A$1" Then Exit Sub
    Application.EnableEvents = False
    With Target
        NewValue = .Value
        Application.Undo
        OldValue = .Value
        .Value = NewValue
    End With
    MsgBox "Old Value: " & OldValue & vbCrLf & "New Value: " & NewValue
    Application.EnableEvents = True
End Sub

When his original code is run, the message box does return the old and new values of the cell. If NewValue and OldValue will return a result for a message box, why can't I use them to copy to another cell?
Could It be because I didn't SET the variable after using the Dim statement?

 

[Marc L]

Yes you can just respecting VBA syntax as a variable can be a property !​

​

What is the purpose of your codeline :​

wsDest.Range("B" & DestTargetValue).OldVal = wsCopy.Range("A" & CopyTargetValue).Value = OldVal

​

​

 

[XrayLemi]

I am trying to copy both the new and old values to a new sheet. I want the old value from whatever LOCKED cell is being changed to be copied to the first empty cell in column B on the destination sheet (Sheet3) then the new value to be copied to column C on the same row on the same sheet. When / If another value is changed, the old and new values will go on the next available row on sheet3. WsDest is the destination sheet.

 

[Marc L]

​

So your codeline is a non sense as for each cell it just needs a codeline like Cell.Value = Variable …​

 

[Marc L]

So just removing all the bad and the useless from the original VBA event procedure if only 'Sheet3' is smart enough :​

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim V(1)
        If Target.CountLarge > 1 then Exit Sub
    If Target.Locked = True Then
        With Application
            .EnableEvents = False
             V(1) = Target.Value
            .Undo
             V(0) = Target.Value
             Target.Value = V(1)
        With ThisWorkbook.Worksheets("Sheet3").UsedRange.Rows
            .Item(.Count + 1).Columns("B:C").Value = V
        End With
            .EnableEvents = True
        End With
    End If
End Sub

​

A trick : use the sheet codename rather than ThisWorkbook.Worksheets("Sheet3") …​

 

[XrayLemi]

That works FANTASTIC! Now all I have to do is incorporate it into my existing code in the REAL workbooks.
Thank you SO much!
Jim

 

[XrayLemi]

Hi Marc,
I have added to the code you gave me in Post #8 . It is doing weird things. The first time the code puts values on sheet 3, it does not go into the columns the code specifies. It arbitrarily picks a column. It could be B and C or even F and G etc. The next entry will go on the next row as it should. However, it will start the next row one column over. So if the first entries were on row 1, columns E and F, The entries on row 2 will start in columns F and G. Any row after row 2 will populate from whatever column row 2 started in. This happens in any workbook I use. It does not matter if I start from a clean slate or if I copy and paste the code into an existing workbook. It also does this with just the original code from post #8.

Any guesses?

Here is the code as I am using it.

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim V(1)
    If Target.CountLarge > 1 Then Exit Sub
      If Not Intersect(Target, Range("C1:C5000,G1:G5000")) Is Nothing Then
        If Target.Locked = True Then
          With Application
           .EnableEvents = False
           V(1) = Target.Value
           .Undo
           V(0) = Target.Value
           Target.Value = V(1)
            With ThisWorkbook.Worksheets("Sheet3").UsedRange.Rows
             .Item(.Count + 1).Columns("B:C").Value = V
             .Item(.Count + 1).Columns("D").Value = Environ("username")
             .Item(.Count + 1).Columns("E").Value = Now
            End With
                Application.ScreenUpdating = False
   Dim outlookApp As Object
   Dim myMail As Object
   Set outlookApp = CreateObject("Outlook.Application")
   Set myMail = outlookApp.CreateItem(0)
   myMail.To = "Me@anybox.net"
   myMail.Subject = "Changes made"
   myMail.HTMLBody = "Unauthorized file changes on " & Application.ActiveWorkbook.Name
   myMail.send
           .EnableEvents = True
          End With
        End If
      End If
End Sub

Thanks Again,
Jim