VBA to log deleted row

K

kizzie37

Well-known Member
Joined
Oct 23, 2007
Messages
585
Office Version
  1. 365
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.

VBA Code: 
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
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
kizzie37 said:
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.

VBA Code: 
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
Click to expand...
**Bump**
 
Upvote 0
kizzie37 said:
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.

VBA Code: 
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
Click to expand...
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?

VBA Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Merge aspects of 2 pieces of VBA Code
Replies
6
Views
487
kizzie37
K
K
  • Locked
  • Question Question
Vba code for User history log which is giving me a run-time error "13" mismatch
Replies
2
Views
138
Fluff
Fluff
K
  • Question Question
VBA Code for User log history
2 3
Replies
21
Views
413
Logit
Logit
F
  • Question Question
VBA Code to record changes/logs modification needed?
Replies
0
Views
355
FGaxha
F
E
  • Question Question
Change Log With VBA
2
Replies
19
Views
850
Joe4
Joe4

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top