Can I create a sort of "Anti Tamper" macro?

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
3,210
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
Hi Everyone,
I have a document thats going to go out to over 200 people.
I have set it up with loads of macros stopping anyone from editing, changing and playing around with it, however there is still the possability that someone might think they know what they are doing and change things as password protection is easily cracked.

so as one last part of security I'd like to check when the document is opened that everthing is how it should be.
So heres what i was thinking.

have a macro that when the document opens checks the tab names,
I have a sheet called "control" in column Z I could list all the tabs in the document by Name,
The macro could then go in and check if any sheets exist that have a different name to this one,
Maybe we could also check the document name is the same as Control A7?

then if any of these errors exist I'd like a message box to pop up saying This document apears to have been tampered with and can no longer be used, please speak with you IT department to have this fixed!
and close the document down.

I know there will always be ways around this, but I think it would help stop the problem.

So if anyone know the macro to do this that would be great.

thanks

Tony
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Try this in the code module for ThisWorkbook:
Code:
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, ws As Worksheet, shName As Range, rng As Range
    Set srcWS = Sheets("Control")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In Sheets
        Set shName = srcWS.Range("Z:Z").Find(ws.Name, LookIn:=xlValues, lookat:=xlWhole)
        If shName Is Nothing Then
            MsgBox ("This document apears to have been tampered with and can no longer be used, please speak with you IT department to have this fixed!")
            ActiveWorkbook.Close False
        End If
    Next ws
    For Each rng In srcWS.Range("Z1:Z" & LastRow)
        If Not WorksheetExists(rng.Value) Then
            MsgBox ("This document apears to have been tampered with and can no longer be used, please speak with you IT department to have this fixed!")
            ActiveWorkbook.Close False
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Worksheets(WSName).Name = WSName
    On Error GoTo 0
End Function
It assumes that the sheet names begin in row 1 of column Z. Don't forget to add "Control" to the list in column Z. It also checks if a sheet has been deleted.
 
Last edited:
Upvote 0
Mumps,
This is perfect, I tested a few things and works great,
thank you so much for your help

Tony
:-)
 
Upvote 0
You are very welcome. :) I would suggest that even though protection isn't that "sturdy", you use it as well. Also prevent the macros from being visible.
To protect your macros, you have to protect your VBA Project. Do the following:
-hold down the ALT key and press the F11 key to open the Visual Basic Editor
-click on 'Tools' on the top menu
-click 'VBAProject Properties'
-click the 'Protection' tab
-click the box to the left of 'Lock project for viewing' to put a check mark in it
-enter your password and then confirm it and click 'OK'
-close the VB Editor
-save your file
When you re-open the file, you will not be able to see the macros unless you enter the password. Keep in mind that this type of protection is not very strong and anyone who really wants to get at your macros can probably do it with a little research. I hope this helps.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

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