PDA

View Full Version : Exclude specific worksheet from existing code



sylwester.cz
05-08-2014, 02:39 AM
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
05-08-2014, 02:51 AM
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
05-08-2014, 04:03 AM
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
05-08-2014, 04:09 AM
I couldn't find any reference to Output in your code, so I used Tracker as that was referenced.

sylwester.cz
05-08-2014, 04:21 AM
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
05-08-2014, 04:45 AM
Can you post your workbook, and give me some instructions as to how to reproduce the problem?

sylwester.cz
05-08-2014, 05:43 AM
I have uploaded a test file here: 11668

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

Bob Phillips
05-08-2014, 07:19 AM
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
05-08-2014, 07:25 AM
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
05-08-2014, 07:31 AM
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
05-08-2014, 07:39 AM
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.