Exclude specific worksheet from existing code

[sylwester.cz]

Dear All,

I have found a great VBA code which suits all my needs (track changes in the workbook) but I need your kind help. In the workbook I have a macro which returns values in a specific sheet called "Output" and that sheet I would like to exclude "Output" sheet from tracking changes, otherwise macro hangs out (as it fills out "Output" with values and at the same time below code is tracking changes in the same sheet "Output").

Unfortunately I do not know how to modify it myself therefore I really count on your help. Thank you very much in advance.

//Sylwester

Option Explicit 
Dim sOldAddress As String 
Dim vOldValue As Variant 
Dim sOldFormula As String 
 
Private Sub Workbook_TrackChange(Cancel As Boolean) 
     
     
    Dim sh As Worksheet 
    For Each sh In ActiveWorkbook.Worksheets 
        sh.PageSetup.LeftFooter = "&06" & ActiveWorkbook.FullName & vbLf & "&A" 
    Next sh 
End Sub 
 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) 


     
    Dim wSheet As Worksheet 
    Dim wActSheet As Worksheet 
    Dim iCol As Integer 
    Set wActSheet = ActiveSheet 
     
     'Precursor Exits
     'Other conditions that you do not want to tracke could be added here
    If vOldValue = "" Then Exit Sub 'If you comment out this line *every* entry will be recorded
     
     'Continue
     
    On Error Resume Next ' This Error-Resume-Next is only to allow the creation of the tracker sheet.
    Set wSheet = Sheets("Tracker") 
     '**** Add the tracker Sheet if it does not exist ****
     
    If wSheet Is Nothing Then 
        Set wActSheet = ActiveSheet 
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker" 
    End If 
    On Error Goto 0 
     '**** End of specific error resume next
     
    On Error Goto ErrorHandler 
    With Application 
        .ScreenUpdating = False 
        .EnableEvents = False 
    End With 
     
    With Sheets("Tracker") 
         '******** This bit of code moves the tracker over a column when the first columns are full**'
        If .Cells(1, 1) = "" Then '
            iCol = 1 '
        Else '
            iCol = .Cells(1, 256).End(xlToLeft).Column - 7 '
            If Not .Cells(65536, iCol) = "" Then '
                iCol = .Cells(1, 256).End(xlToLeft).Column + 1 '
            End If '
        End If '
         '********* END *****************************************************************************'
        .Unprotect Password:="Secret" 
         
         '******** Sets the Column Headers **********************************************************
        If LenB(.Cells(1, iCol).Value) = 0 Then 
            .Range(.Cells(1, iCol), .Cells(1, iCol + 7)) = Array("Cell Changed", "Old Value", _ 
            "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User") 
            .Cells.Columns.AutoFit 
        End If 
         
        With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1) 
             
            .Value = sOldAddress 
             
            .Offset(0, 1).Value = vOldValue 
            .Offset(0, 3).Value = sOldFormula 
             
            If Target.Count = 1 Then 
                .Offset(0, 2).Value = Target.Value 
                If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula 
            End If 
             
            .Offset(0, 5) = Time 
            .Offset(0, 6) = Date 
            .Offset(0, 7) = Application.UserName 
            .Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous 
        End With 
         
         '.Protect Password:="Secret"  'Uncomment to protect the "tracker tab"
         
    End With 
ErrorExit: 
    With Application 
        .ScreenUpdating = True 
        .EnableEvents = True 
    End With 
     
    wActSheet.Activate 
    Exit Sub 
     
ErrorHandler: 
     'any error handling you want
     'Debug.Print "We have an error"
    Resume ErrorExit 
     
End Sub 
 
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range) 
     
    With Target 
        sOldAddress = .Address(external:=True) 
         
        If .Count > 1 Then 
             
            vOldValue = "Multiple Cell Select" 
            sOldFormula = vbNullString 
             
        Else 
             
            vOldValue = .Value 
            If .HasFormula Then 
                sOldFormula = "'" & Target.Formula 
            Else 
                sOldFormula = vbNullString 
            End If 
        End If 
    End With 
End Sub

[Bob Phillips]

I would think it is just

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim wSheet As Worksheet
Dim wActSheet As Worksheet
Dim iCol As Integer
    
    Set wActSheet = ActiveSheet
     
    If sh.Name <> "Tracker" Then
    
        'Precursor Exits
         'Other conditions that you do not want to tracke could be added here
        If vOldValue = "" Then Exit Sub 'If you comment out this line *every* entry will be recorded
         
         'Continue
         
        On Error Resume Next ' This Error-Resume-Next is only to allow the creation of the tracker sheet.
        Set wSheet = Sheets("Tracker")
         '**** Add the tracker Sheet if it does not exist ****
         
        If wSheet Is Nothing Then
            Set wActSheet = ActiveSheet
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker"
        End If
        On Error GoTo 0
         '**** End of specific error resume next
         
        On Error GoTo ErrorHandler
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
         
        With Sheets("Tracker")
             '******** This bit of code moves the tracker over a column when the first columns are full**'
            If .Cells(1, 1) = "" Then '
                iCol = 1 '
            Else '
                iCol = .Cells(1, 256).End(xlToLeft).Column - 7 '
                If Not .Cells(65536, iCol) = "" Then '
                    iCol = .Cells(1, 256).End(xlToLeft).Column + 1 '
                End If '
            End If '
             '********* END *****************************************************************************'
            .Unprotect Password:="Secret"
             
             '******** Sets the Column Headers **********************************************************
            If LenB(.Cells(1, iCol).Value) = 0 Then
                .Range(.Cells(1, iCol), .Cells(1, iCol + 7)) = Array("Cell Changed", "Old Value", _
                "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                .Cells.Columns.AutoFit
            End If
             
            With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1)
                 
                .Value = sOldAddress
                 
                .Offset(0, 1).Value = vOldValue
                .Offset(0, 3).Value = sOldFormula
                 
                If Target.Count = 1 Then
                    .Offset(0, 2).Value = Target.Value
                    If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
                End If
                 
                .Offset(0, 5) = Time
                .Offset(0, 6) = Date
                .Offset(0, 7) = Application.UserName
                .Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
            End With
             
             '.Protect Password:="Secret"  'Uncomment to protect the "tracker tab"
             
        End With
    End If
ErrorExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
     
    wActSheet.Activate
    Exit Sub
     
ErrorHandler:
     'any error handling you want
     'Debug.Print "We have an error"
    Resume ErrorExit
End Sub

[sylwester.cz]

Hi,

Thank you for quick reply.

I have tried your code, pasted it into ThisWorkbook but now the code does not work at all

Please let me know what has gone wrong.

Also I have noticed this new line:

 If sh.Name <> "Tracker" Then

- it supposed to exclude sheet "output" but even if I changed the name from "Tracker" to "output" it still does not work.

[Bob Phillips]

I couldn't find any reference to Output in your code, so I used Tracker as that was referenced.

[sylwester.cz]

I will try to shortly explain my workbook:
- sheet "Revenues" is an input data sheet
- sheet "output" is a sheet were a macro (not specified in this thread) copies values from different places/combinations from "Revenue"
- there are ca 10 sheets with different pivot tables which are based on "output" sheet
- sheet "Tracker" supposed to track changes on all sheets except "output" based on the code pasted in the beginning if this thread.

The other solution which would be also perfect for me is that code from this thread track changes ONLY in the "Revenue" sheet. Is it doable?

[Bob Phillips]

Can you post your workbook, and give me some instructions as to how to reproduce the problem?

[sylwester.cz]

I have uploaded a test file here: Test Test.xlsm

I have also explained what is the aim in the "Revenue" sheet. Thank you

[Bob Phillips]

I used the code that I gave you, just changed the sheet name from Tracker to output and it worked fine.

BTW, I couldn't get the macro to hang as you said happens.

[sylwester.cz]

I think we are still not on the same page, and it is my fault.

Would you please help me to modify the code to have only the following result: any changes in the "Revenue" sheet will be reported in the "Tracker" sheet (at the moment code track and report changes made in every sheet, except "Tracker" of course). Basically the code should ignore all other sheets, it should focus only on the "Revenues".

Thank you again.

[Bob Phillips]

You said it tracked changes to output, and I offered code to fix that. You are right, we are not on the same page.

[sylwester.cz]

I am sorry, I was not clear enough. There is another macro in the worksheet with button in the "Revenue" sheet. Once the button is clicked it copies data from "Revenue" sheet to the "output" sheet. "output" sheet is needed for other pivot tables which exist in the workbook.

Now, when other users make changes in the "Revenue" sheet I do not have control on this (it has 10000+ rows) and therefore the code pasted in this thread is only to track those changes in "Revenue" sheet and report them in the "Tracker" sheet so I can easily spot them and review.

Please let me know if I have explained it a bit better now.