Detailed recently modified cell stamp

[ReignEternal]

Hello,

I have been doing some searching and have been able to put this together but I am confused. From what i can read in the VBA below, I thought this should insert the data in A1:E1 but what is happening, is the data is being entered at the bottom of my table. I have a feeling I have butchered my attempt. I was aiming to be able to have any edits from any worksheet display the cell that was changed on a separate sheet, (the old data, the new data, the time it was changed, the date it was changed and the author that made the change). Now this is working to a degree. I have placed the VBA in each worksheet, when I tried to place it in the workbook any edit from any sheet was always going to a sheet I renamed. After doing some digging, I found out the sheet I renamed used to be Sheet1. I am assuming that I simply need to create a new sheet and replace where it says "Sheet1" to the new sheet # I create?

Dim vOldVal 'Must be at top of module

Private Sub Worksheet_Change(ByVal Target As Range)

Dim bBold As Boolean



If Target.Cells.Count > 1 Then Exit Sub

On Error Resume Next



    With Application

         .ScreenUpdating = False

         .EnableEvents = False

    End With

Target.Interior.ColorIndex = 19

    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"

    bBold = Target.HasFormula

        With Sheet1

                If .Range("A1") = vbNullString Then

                    .Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _
                        "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")

                End If


            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)

                  .Value = Target.Address

                  .Offset(0, 1) = vOldVal

                      With .Offset(0, 2)

                        If bBold = True Then

                          .ClearComments

                        End If

                          .Value = Target

                          .Font.Bold = bBold

                      End With



                .Offset(0, 3) = Time

                .Offset(0, 4) = Date
                
                .Offset(0, 5) = ActiveWorkbook.BuiltinDocumentProperties("Last Author")

            End With

            .Cells.Columns.AutoFit


        End With

    vOldVal = vbNullString



    With Application

         .ScreenUpdating = True

         .EnableEvents = True

    End With



On Error GoTo 0

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    vOldVal = Target

End Sub

Here is a link to the workbook My workbook

 

[DanteAmor]

I was aiming to be able to have any edits from any worksheet display the cell that was changed on a separate sheet

For that create a new sheet. It can be at the beginning or end of all sheets. You name it whatever you want, for example: "Changes".
And you put the code in quotes:

Change this line:

With Sheet1

For this line:

With Sheets("Changes")

 

[DanteAmor]

Try this:

Delete the code from all the sheets and use only the following code, but you put it in the ThisWorkbook events.
Works for all sheets except "Changes" sheet

Dim vOldVal 'Must be at top of module
Const shChanges As String = "Changes"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Name = shChanges Then Exit Sub
  Dim bBold As Boolean
  If Target.Cells.Count > 1 Then Exit Sub
  On Error Resume Next
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  Target.Interior.ColorIndex = 19
  If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
  bBold = Target.HasFormula
  With Sheets(shChanges)
    If .Range("A1") = vbNullString Then
      .Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _
      "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")
    End If
    With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
      .Value = Target.Address
      .Offset(0, 1) = vOldVal
      With .Offset(0, 2)
        If bBold = True Then
          .ClearComments
        End If
        .Value = Target
        .Font.Bold = bBold
      End With
      .Offset(0, 3) = Time
      .Offset(0, 4) = Date
      .Offset(0, 5) = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
    End With
    .Cells.Columns.AutoFit
  End With
  vOldVal = vbNullString
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With
  On Error GoTo 0
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Name = shChanges Then Exit Sub
  vOldVal = Target
End Sub

 

[ReignEternal]

This worked. I didn't even consider to exclude the "Change" sheet. The only two issues I am experiencing are

1. When I select the entire sheet, I get runtime error 7, out of memory
2. If I make an edit to more than one cell at a time, the edit do not transfer over to the "Changes" sheet.

 

[DanteAmor]

1. When I select the entire sheet, I get runtime error 7, out of memory

Use this:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If Target.CountLarge > 1 Then Exit Sub
  If Sh.Name = shChanges Then Exit Sub
  vOldVal = Target
End Sub

2. If I make an edit to more than one cell at a time, the edit do not transfer over to the "Changes" sheet.

The original macro was only set up to record only the change in one cell.


What exactly steps are you taking to modify 2 or more cells at the same time?

Take into account that you will not be able to modify more cells than those selected, that is, if you select 3 cells, you will only be able to modify 3 cells.
The code works like this: you select a cell, the value of the cell is saved as "old". You modify the cell. The "old" and the "new" one are written in the "changes" sheet.

So to store 3 cells, you must first select 3 cells, then (somehow) modify the 3 cells, that way the code will be able to register 3 "old" and 3 "new".

I don't even know if it is possible to do it, I would have to check it out. So I ask you again, how are you going to modify 2 cells or more at the same time?

 

[DanteAmor]

I give you the following code to modify up to a matrix of 10 rows by 10 columns, 100 cells at the same time.

As I said, you must first select the cells that you are going to modify, then modify all the cells at the same time. It can be erasing them, or pasting information that is in memory.

Copy all the code:

Dim vOldVal(1 To 10, 1 To 10)           'Must be at top of module
Const shChanges As String = "Changes"   'sheet with changes

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim bBold As Boolean
  Dim vOldCell As Variant
  Dim i As Long, j As Long
  
  If Sh.Name = shChanges Then Exit Sub
  If Target.CountLarge > 100 Then Exit Sub
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  
  Target.Interior.ColorIndex = 19
  For i = 1 To Target.Rows.Count
    For j = 1 To Target.Columns.Count
      If vOldVal(i, j) = "" Then vOldCell = "Empty Cell" Else vOldCell = vOldVal(i, j)
      bBold = Target.Cells(i, j).HasFormula
      With Sheets(shChanges)
        If .Range("A1") = vbNullString Then .Range("A1:E1") = _
          Array("CELL CHANGED", "OLD VALUE", "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")
        With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
          .Value = Target.Cells(i, j).Address
          .Offset(0, 1) = vOldCell
          If bBold Then .Offset(0, 2).ClearComments
          .Offset(0, 2).Font.Bold = bBold
          .Offset(0, 2) = Target.Cells(i, j).Value
          .Offset(0, 3) = Time
          .Offset(0, 4) = Date
          .Offset(0, 5) = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
        End With
        .Cells.Columns.AutoFit
        vOldVal(i, j) = ""
      End With
    Next
  Next
  
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If Target.CountLarge > 100 Then Exit Sub
  If Sh.Name = shChanges Then Exit Sub
  Dim i As Long, j As Long
  For i = 1 To Target.Rows.Count
    For j = 1 To Target.Columns.Count
      vOldVal(i, j) = Target.Cells(i, j).Value
    Next
  Next
End Sub

 

[ReignEternal]

I give you the following code to modify up to a matrix of 10 rows by 10 columns, 100 cells at the same time.

As I said, you must first select the cells that you are going to modify, then modify all the cells at the same time. It can be erasing them, or pasting information that is in memory.

Copy all the code:

Dim vOldVal(1 To 10, 1 To 10)           'Must be at top of module
Const shChanges As String = "Changes"   'sheet with changes

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim bBold As Boolean
  Dim vOldCell As Variant
  Dim i As Long, j As Long
 
  If Sh.Name = shChanges Then Exit Sub
  If Target.CountLarge > 100 Then Exit Sub
 
  Application.ScreenUpdating = False
  Application.EnableEvents = False
 
  Target.Interior.ColorIndex = 19
  For i = 1 To Target.Rows.Count
    For j = 1 To Target.Columns.Count
      If vOldVal(i, j) = "" Then vOldCell = "Empty Cell" Else vOldCell = vOldVal(i, j)
      bBold = Target.Cells(i, j).HasFormula
      With Sheets(shChanges)
        If .Range("A1") = vbNullString Then .Range("A1:E1") = _
          Array("CELL CHANGED", "OLD VALUE", "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")
        With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
          .Value = Target.Cells(i, j).Address
          .Offset(0, 1) = vOldCell
          If bBold Then .Offset(0, 2).ClearComments
          .Offset(0, 2).Font.Bold = bBold
          .Offset(0, 2) = Target.Cells(i, j).Value
          .Offset(0, 3) = Time
          .Offset(0, 4) = Date
          .Offset(0, 5) = ActiveWorkbook.BuiltinDocumentProperties("Last Author")
        End With
        .Cells.Columns.AutoFit
        vOldVal(i, j) = ""
      End With
    Next
  Next
 
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  If Target.CountLarge > 100 Then Exit Sub
  If Sh.Name = shChanges Then Exit Sub
  Dim i As Long, j As Long
  For i = 1 To Target.Rows.Count
    For j = 1 To Target.Columns.Count
      vOldVal(i, j) = Target.Cells(i, j).Value
    Next
  Next
End Sub

I will be trying this today. As you requested, here is what we are doing when modifying multiple cells. There are times when we drag an select multiple columns or rows then delete the data. There are times when we grab a group of cells and delete the data there are times we grab the whole table to clear all formatting and contents (rare). After reading your VBA alterations, I believe this will work beautifully. I will let you know as soon as I have it tested. Thank you very much for helping with this.

 

[DanteAmor]

I don't think a macro is the solution to your need.
If you handle too many changes, you may need software that controls the versions of each file.

 

[ReignEternal]

I don't think a macro is the solution to your need.
If you handle too many changes, you may need software that controls the versions of each file.

Understood. I tested out the VBA modifications and I works to a point. When editing multiple cells at once, thats when it doesnt. The good part is that now when I select the whole page, it no longer gives me a runtime error.