VBA to log deleted row

[kizzie37]

I have the following code (from another forum) which works great for tracking changes in an excel sheet where the built in "track changes" option cant be used. Is there a way to add to this code to show when a row in any of the sheets is deleted.?

I realize that this would mean multiple entries on the "log sheet" as the row could be made of up many cells containing data.

Option Explicit


Dim vOldVal 'Must be at top of module


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Dim bBold As Boolean




If Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Name = "Pricing" Then Exit Sub


'On Error Resume Next


    With Application
         .ScreenUpdating = False
         .EnableEvents = False


    End With


    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheets("Tracker")
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                End If


            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
                .ClearComments
                .AddComment.Text Text:= _
                     "OzGrid.com:" & Chr(10) & "" & Chr(10) & _
                        "Bold value is the result of formula change"


              End If
                .Value = Target
                .Font.Bold = bBold
                
            End With
                .Offset(0, 5) = Time
                .Offset(0, 6) = Date
                .Offset(0, 7) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
        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)
    vOldVal = Target
End Sub


Private Sub test()
    Application.EnableEvents = True
End Sub

 

[kizzie37]

I have the following code (from another forum) which works great for tracking changes in an excel sheet where the built in "track changes" option cant be used. Is there a way to add to this code to show when a row in any of the sheets is deleted.?

I realize that this would mean multiple entries on the "log sheet" as the row could be made of up many cells containing data.

Option Explicit


Dim vOldVal 'Must be at top of module


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Dim bBold As Boolean




If Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Name = "Pricing" Then Exit Sub


'On Error Resume Next


    With Application
         .ScreenUpdating = False
         .EnableEvents = False


    End With


    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheets("Tracker")
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                End If


            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
                .ClearComments
                .AddComment.Text Text:= _
                     "OzGrid.com:" & Chr(10) & "" & Chr(10) & _
                        "Bold value is the result of formula change"


              End If
                .Value = Target
                .Font.Bold = bBold
               
            End With
                .Offset(0, 5) = Time
                .Offset(0, 6) = Date
                .Offset(0, 7) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
        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)
    vOldVal = Target
End Sub


Private Sub test()
    Application.EnableEvents = True
End Sub

**Bump**

 

[kizzie37]

I have the following code (from another forum) which works great for tracking changes in an excel sheet where the built in "track changes" option cant be used. Is there a way to add to this code to show when a row in any of the sheets is deleted.?

I realize that this would mean multiple entries on the "log sheet" as the row could be made of up many cells containing data.

Option Explicit


Dim vOldVal 'Must be at top of module


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Dim bBold As Boolean




If Target.Cells.Count > 1 Then Exit Sub
If ActiveSheet.Name = "Pricing" Then Exit Sub


'On Error Resume Next


    With Application
         .ScreenUpdating = False
         .EnableEvents = False


    End With


    If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
    bBold = Target.HasFormula
        With Sheets("Tracker")
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                End If


            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & Target.Address
                  .Offset(0, 1) = vOldVal
            With .Offset(0, 2)
              If bBold = True Then
                .ClearComments
                .AddComment.Text Text:= _
                     "OzGrid.com:" & Chr(10) & "" & Chr(10) & _
                        "Bold value is the result of formula change"


              End If
                .Value = Target
                .Font.Bold = bBold
              
            End With
                .Offset(0, 5) = Time
                .Offset(0, 6) = Date
                .Offset(0, 7) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            '.Protect Password:="Secret"
        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)
    vOldVal = Target
End Sub


Private Sub test()
    Application.EnableEvents = True
End Sub

So this piece of code does the task I want, but I dont know how to add in into the existing code. Can anyone help with that?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim What As String

If Target.Columns.Count = Columns.Count And _
WorksheetFunction.CountA(Selection) > 0 Then
    What = "Row " & Target.Row & " Deleted along with " & Target.Rows.Count - 1 & " additonal rows"
    Call DocumentChange(What)
End If

If Target.Rows.Count = Rows.Count And _
WorksheetFunction.CountA(Selection) > 0 Then
    What = "Column " & Target.Column & " Deleted along with " & Target.Columns.Count - 1 & " additonal columns"
    Call DocumentChange(What)
End If

End Sub