track changes on protected sheet using VBA

[kingnitwit]

Hi There,

I'm still quite new to VBA, so hoping someone could give me some advice.

I have an excelsheet in which only certain columns are allowed to be modified by other users, thus I've protected these particular columns.

However, I also want to be able to track any changes and I thought i'd found the solution here using the following code:

Option ExplicitDim 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:="omega"

 

'******** 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:="omega" '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

Unfortunately I get an error telling me the cell I'm trying to change is on a protected sheet and I need to unprotect it in order for it to work, which is strange as this particular cell is not protected and can be altered without any issues.

when I click 'debug' it is the .AdComment part it seems to be having some trouble with. is there a way around this so as the code works, without having to unprotect the sheet?

Would really appreciate the help.

 

[Fluff]

Duplicate https://www.mrexcel.com/forum/excel-questions/1060112-track-changes-protected-sheet-using-vba.html

Note that sometimes posts from new users require Moderator approval before you can see them on the public forums. When this happens, you should see a message to that effect when you try to post it.
Please be patient and do not attempt to post the question again