VBA Protect Shared Workbook with Track Changes Enabled and Password

elmer007

Active Member
Joined
Aug 29, 2014
Messages
299
Hi,

This is my first post- please forgive/inform me of any mistakes.

I am trying to automate a repetitive reporting process. Before I can upload my reports, I have to protect a sheet, protect the workbook, and "Protect Shared Workbook." This last step brings up a box where I check "Sharing with track changes" and assign a password.

So far, I have successfully written macros for everything except the final step of protecting the shared workbook with a password for track changes. My many attempts at this last step have resulted in a variety of different failures and/or errors. Any help would be much appreciated!

The first half of the code does four things:
1) deletes a sheet called 'MasterListCopy'
2) makes a copy of the current 'MasterList' and names it 'MasterListCopy'
3) sets up conditional formatting to highlight any cells on the 'MasterList' that are not equal to their corresponding cell on the 'MasterListCopy' tab (used for bringing attention to worksheet updates)
4) hides the 'MasterListCopy' sheet

After these four things, the code for protecting the various aspects begins. I believe this is where the trouble lies...


Here is the code that I am working with now:

Code:
Sub Cond_Formatting_and_Protection()
'
' Cond_Formatting_and_Protection Macro
'
' Keyboard Shortcut: Ctrl+m
'
    If Not ActiveSheet.Name = "MasterList" Then
        MsgBox ("Macro: CTRL+m" & vbCrLf & "     -Set the conditional formatting and add protection to the sheet and workbook" & vbCrLf & vbCrLf & vbCrLf & "This is the wrong tab for this macro.  Run this from the 'MasterList' tab.")
        Exit Sub
    End If
    
    If Sheets("MasterList").ProtectContents = True Then
        MsgBox ("Cannot run this procedure when worksheet is already protected.")
        Exit Sub
    End If
    
    If MsgBox("Set the conditional formatting and protect the sheet and workbook?", vbYesNo, "Selection") = vbNo Then Exit Sub
    
    Application.DisplayAlerts = False
    
    On Error GoTo ErrHandler:
    Sheets("MasterListCopy").Visible = True
    Sheets("MasterListCopy").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

ErrHandler:
Resume AfterError:
AfterError:
    
    Application.DisplayAlerts = True
    
    Sheets("MasterList").Select
    Sheets("MasterList").Copy Before:=Sheets(3)
    ActiveSheet.Name = "MasterListCopy"
    Sheets("MasterList").Select
    
    Columns("C:AQ").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
        Formula1:="=MasterListCopy!C1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    Sheets("MasterListCopy").Select
    ActiveWindow.SelectedSheets.Visible = False

    'I believe everything prior to this point works correctly
    'Next is where I try to protect the sheet, workbook, and protect and share

    
    Sheets("MasterList").Select
    ActiveSheet.Protect Password:="mypassword", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowSorting:= _
        True, AllowFiltering:=True

    ActiveWorkbook.Protect Password:="mypassword", Structure:=True, Windows:=False

    ActiveWorkbook.ProtectSharing SharingPassword:="mypassword"
    
End Sub

I need the last portion of the code to be able to protect the shared workbook with track changes enabled and assign a password as the last thing that happens before the workbook is available to other users. Everything works fine without the very last line of code before the "end sub." When I put this back in, it doesn't work right.

Thanks to anyone that looks into it!
 
Last edited:

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
After stepping through the code it doesn't seem like you need the last line of code


Code:
 ActiveWorkbook.ProtectSharing SharingPassword:=mypassword

Thsee two lines seem to have password Protected MasterList


Code:
ActiveSheet.Protect Password:="mypassword", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowSorting:= _
        True, AllowFiltering:=True


    ActiveWorkbook.Protect Password:="mypassword", Structure:=True, Windows:=False
 
Last edited by a moderator:
Upvote 0
The two lines referenced only protect the sheet (from changes to cells) and workbook (from hiding/unhiding/deleting tabs). However, I need to share the workbook with a password as well, which those two lines don't do. Basically, the code gets me to the terminal, but I'm not quite on the plane. Thanks for looking into it!
 
Last edited by a moderator:
Upvote 0
Basically, I need to figure out how to make the "Protect Shared Workbook" with password for track changes feature run from VBA.
 
Upvote 0
Have you tried recording a macro to get the code?

I did try this, which got me everything except the last part. Sharing the file seems to affect the usability of VBA (for instance, you can't open the project to view the code while it's shared). I think that when I click the last steps while recording that the recording just stops unfortunately.
 
Upvote 0
Only record the one step to get the code to protect the whole workbook. Then add it to your code afterwards. Sry not near computer to attempt myself.
 
Upvote 0
Only record the one step to get the code to protect the whole workbook. Then add it to your code afterwards. Sry not near computer to attempt myself.

The step that I need to record is the step that shares the workbook (and, consequently, stops the recording process).
 
Upvote 0
Or if someone knows how to continue recording after the workbook is shared then that would solve this as well
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,048
Members
448,543
Latest member
MartinLarkin

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