I'm creating a excel application that will be distributed to my associates. Based permissions I need to disable access to certain sheets and features. I've been able to protect and hide sheets but a savvy user is able to iterate over hidden worksheets internally or externally to expose data. I need to stop that.
Here's the process:
When the workbook opens a query to remote database is made to return set of user permissions. Then those permissions are printed to worksheet called "PERMISSIONS".
This code below iterates over worksheet permissions to find a particular setting by passing in column name.
CheckPerm "Timesheet"
Public Function CheckPerm(nPermColTarget As String) As Boolean
Dim Counter As Integer
Dim x As Integer
Dim y As Integer
Counter = 3
Do Until Sheet7.Cells(Counter, 1).Value = Associate_Name
Counter = Counter + 1
Loop
y = Counter
Counter = 2
Do Until Sheet7.Cells(2, Counter).Value = nPermColTarget
Counter = Counter + 1
Loop
x = Counter
If Sheet7.Cells(y, x).Value = "ON" Then
CheckPerm = True
GrntDenySheetAccess nPermColTarget, y, x, CheckPerm
Else
' "OFF"
CheckPerm = False
GrntDenySheetAccess nPermColTarget, y, x, CheckPerm
End If
End Function
Private Sub GrntDenySheetAccess(nPermColTarget As String, y As Integer, _
x As Integer, CheckPerm As Boolean)
Select Case nPermColTarget
' Sheet1
Case "Timesheet"
If CheckPerm = True Then
Sheet1.Unprotect "pass"
Sheet1.Visible = xlSheetVisible
End If
If CheckPerm = False Then
Sheet1.Protect "pass"
Sheet1.Visible = xlSheetVeryHidden
End If
End Select
End Sub
But even though sheet1 is hidden and protected, I can still iterate over hidden sheet1's content to access info. Anyway to stop that?
Thanks
There aren't any ways to safely protect access to anything in an Excel workbook. Passwords are much harder to crack in Excel versions 2007 and onward, but a user can simply save the workbook as a .xls file and then it becomes easy to crack.
The best you can do is to make it a little tougher for somebody to get into. Password protect your file, and set any sheets that you don't want them to get to to xlSheetVeryHidden, which prevents users from unhiding the sheets through the Excel user interface.
The commenters under your question are correct. If you want a secure application, Excel isn't the answer.
Having said that, if you enforce security in the database layer, Excel makes a great UI. Just make sure you don't store or retrieve data that the user shouldn't see.
Related
I want to create a macro that will generate N number of template sheets based on the value of a cel. For example, User inputs 4 into this particular cell and it subsequently generates 4 new sheets in the workbook of this template.
I've searched all through Stack overflow for a question that matches mine but none do. The closest I found was this and although the inital headline question asks generally the same question, when going into detail the user who asked this changes their question to"insert number of cells based on a cell value". Still I used this as a starting point.
Sub CreateSheets()
Dim facilitiesNum As Integer
facilitiesNum = Range("B2").Value
sheetsNeeded = facilitiesNum
With ThisWorkbook.Sheets
For i = sheetsNeeded To Master.Range("B2").Value2
.Item("TemplateSheet").Copy After:=.Item(.Count)
.Item(.Count).Name = sheetsNeeded
Next
End With
End Sub
I am new to VBA so I could be very off syntax-wise but in pseudocode my goal is
numberOfTemplates = cell value
numSheetsNeeded = numberOfTemplates
For i = numSheetsNeeded To NumOfTemp:
create sheets using numSheetsNeeded as reference for how many need to be
generated
How do I go about doing this?
If you just want to add new sheets this should be enough
Sub CreateSheets()
Dim facilitiesNum As Long
facilitiesNum = Range("B2").Value
With ThisWorkbook.Sheets
For i = 1 To facilitiesNum
.Item("TemplateSheet").Copy After:=.Item(.Count)
.Item(.Count).Name = i
Next i
End With
end sub
I am new to excel VBA and I can't find my answer anywhere. In my Worksheet "Follow-Up Log" I would like cells with no text in the range A1:A70 to allow user edits (then automatically lock after the change) while those cells with text are password protected at all times. I would also like the range to use a different password than the worksheet and for the user to enter in the password anytime they wish to edit a cell with text in the range.
I am hoping to apply the same code to ranges B1:B70, K1:K70, but a different password for each range, all of which are different from the worksheet. Overall I intend to have 4 passwords for this single sheet.
The current code I'm using locks cells after the text has been entered but it's changing the Worksheet password instead of just the cells and you only enter the password once. Does this make sense? Here's the code I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim blnUnlockedAllCells As Boolean
Const RangeToLock As String = "A2:A70" '<< adjust to suit
If Target.Cells.Count > 1 Then Exit Sub
If Not blnUnlockedAllCells Then
Me.Cells.Locked = False
On Error Resume Next
Me.Range(CStr(RangeToLock)).SpecialCells(2).Locked = True
On Error GoTo 0
blnUnlockedAllCells = True
Me.Protect Password:="pwd", userinterfaceonly:=True
End If
If Not Application.Intersect(Target, Me.Range(CStr(RangeToLock))) Is Nothing Then
If Len(Target) Then Target.Locked = True
End If
You dont need to lock them. I just recorded this macro to figure out how to do it for multiple ranges:
With ActiveSheet
.Protection.AllowEditRanges.Add Title:="Range1", Range:=.Range("G8:J10"), Password:="qq"
.Protection.AllowEditRanges.Add Title:="Range2", Range:=.Range("K11:L12"), Password:="aa"
End With
But keep in mind that if the person knows how to open the code window, they will be easily able to see your passwords.
The code "setupranges" can set up the ranges and passwords to edit. This does all the work. Copy and paste both of the following subroutines into a new module (insert a module). Make sure you change the passwords to any you have already set.
Sub setupranges(wsname As String, rangeX As String)
Dim rangea, rangeb, rangek As String
Dim pwda, pwdb, pwdk As String
Dim Ws As Worksheet
Dim pwdws As String
Set Ws = Worksheets(wsname)
rangea = "A1:A70"
rangeb = "B1:B70"
rangek = "K1:K70"
pwda = "aaa"
pwdb = "bbb"
pwdk = "kkk"
pwdws = "pwd"
On Error Resume Next
Ws.Unprotect Password:=pwdws
On Error GoTo 0
Select Case rangeX
Case Is = "all"
Call deleterangeifexists(Ws, "a")
Ws.Protection.AllowEditRanges.Add Title:="arange",Range:=Ws.Range(rangea), Password:=pwda
Call deleterangeifexists(Ws, "b")
Ws.Protection.AllowEditRanges.Add Title:="brange", Range:=Ws.Range(rangeb), Password:=pwdb
Call deleterangeifexists(Ws, "k")
Ws.Protection.AllowEditRanges.Add Title:="krange", Range:=Ws.Range(rangek), Password:=pwdk
Case Is = "a"
Call deleterangeifexists(Ws, "arange")
Ws.Protection.AllowEditRanges.Add Title:="arange", Range:=Ws.Range(rangea), Password:=pwda
Case Is = "b"
Call deleterangeifexists(Ws, "brange")
Ws.Protection.AllowEditRanges.Add Title:="brange",Range:=Ws.Range(rangeb), Password:=pwdb
Case Is = "k"
Call deleterangeifexists(Ws, "krange")
Ws.Protection.AllowEditRanges.Add Title:="krange", Range:=Ws.Range(rangek), Password:=pwdk
End Select
Ws.Protect Password:=pwdws, userinterfaceonly:=True
End Sub
You'll get an error if the range already exists when you try to add it, so this deletes the defined range if it already exists.
Sub deleterangeifexists(Ws As Worksheet, Title As String)
Dim rangetocheck As AllowEditRange
For Each rangetocheck In Ws.Protection.AllowEditRanges
If rangetocheck.Title = Title Then
rangetocheck.Delete
Exit Sub
End If
Next
End Sub
Then you have to call setupranges from your worksheet e.g.
call setupranges("sheet1","all")
would reset all passwords for all ranges.
call setupranges("sheet1","arange")
would reset the password for the range in column A only.
I would suggest either worksheet_change or worksheet_selectionchange depending on how you want your workbook to behave.
With Worksheet_change bear in mind that your user might unlock a range, then not change anything so your routine wouldn't run and the range would remain unlocked. With Worksheet_selectionchange the code's going to run with every change of cell focus which might be slow. One of them gives you as Target the cell you're now in and one gives you the cell you came from and that might make it easier or harder for you.
Either way, your worksheet code will have:
If condition is true (whatever condition you want to measure) Then
call setupranges("sheet1","all")
End If
I have two spreadsheets; I'll call them spreadsheet 1 and spreadsheet 2. Spreadsheet one has a function which generates days of the month, and if it's at the end of the month, it is trying to call the module/sub in spreadsheet 2. This is to generate both "daily" reports and "monthly" reports.
At this point, there are two errors: the first is when I am trying to save the new instance of spreadsheet 2 that I created. The error is that it asks to save the workbook in a macro-free format. I simply want to save it! Not to make any changes to formatting. I am not even sure that it is trying to save changes to the instantiated book object.
the second is in spreadsheet 2, even though I set it to be active sheet (I think), the activesheet still comes up as the worksheet on spreadsheet 1 that runs the macro in the first place.
Any help is appreciated.
Option Explicit
Public Function LastWeekOfMonth() As Boolean
'finds the current date
Dim CurrentDate As Date
CurrentDate = CDate(ActiveSheet.Cells(FIRST_DATA_ROW, 1))
'find filepath and filename of the monthly documentation file
Dim mFilePath As String
Dim mFileName As String
mFilePath = "F:\Project Sweep\Kim Checklist\Barry Polinsky\Brathwaite, Tamika\"
mFileName = Cells(3, 4) & ".m_d.xlsm"
'if it is the last week of the month, write a monthly report, and return true to continue with the face to face paperwork
If (31 - Day(CurrentDate)) <= 7 Then
'write a monthly report
Dim app As New Excel.Application
Dim book As Excel.Workbook
' app.Visible = False 'Visible is False by default, so this isn't necessary
Set book = app.Workbooks.Add(mFilePath & mFileName)
'run the subroutine CheckSpreadsheet in module WriteReport in target book
app.Run "'" & mFilePath & mFileName & "'!" & "WriteReport" & ".CheckSpreadsheet", book
' CheckSpreadsheet (book)
'error next line
book.Save
book.Close
app.Quit
Set app = Nothing
LastWeekOfMonth = True
'if it is not, simply continue with the face to face paperwork
Else
LastWeekOfMonth = False
End If
End Function
In the target worksheet, in module WriteReport, subroutine CheckSpreadsheet, the following code is located.
Option Explicit
Public Sub CheckSpreadsheet(wbook As Excel.Workbook)
Set wosheet = wbook.Sheets("Monthly")
wosheet.Cells(5, 5) = "Hello world!"
End Sub
Don't need to have another instance of Excel, the property to hide a workbook is Windows, in order to hide the excel windows used by the workbook. Also bear in mind that a workbook can have more than one window.
If you are sure that the workbook you want to hide has only one window use this line:
Workbooks("WbkName").Windows(1).Visible = False
If the workbook has several windows use this procedure:
Sub Wbk_Hide()
Dim wbk As Workbook, wdw As Window
Set wbk = Workbooks("WbkName") 'Update as required
For Each wdw In wbk.Windows
wdw.Visible = False
Next
End Sub
I believe this changes the scope of your procedures, let me know otherwise.
I have a button that triggers a chain of events. One of these events is to delete a sheet. Before the user deletes anything, I pop up my custom YES/NO message asking them to confirm the whole process.
Then comes the sub event of deleting the sheet, and Excel pops up its own window for confirming the removal of the sheet. Problem is that if the user says "no" at that point, that sets my application in an inconsistent state.
How can I bypass Excel asking to confirm the deletion of a sheet ?
You can change the default display alert parameter of Excel using:
Application.DisplayAlerts = False
don't forget to restore the standard behavior at the end of your process:
Application.DisplayAlerts = True
I ran into this issue using Excel 2016, and surprisingly DisplayAlerts was useless. Not sure if anyone else has experienced this. I'm still unsure as to why, but reading this thread, according to the remarks of the Worksheet.Delete method (here):
When you delete a Worksheet , this method displays a dialog box that prompts the user to confirm the deletion. This dialog box is displayed by default. When called on the Worksheet object, the Delete method returns a Boolean value that is False if the user clicked Cancel on the dialog box or True if the user clicked Delete.
In Excel 2016, though Application.DisplayAlerts was set to False, it kept showing the alert after (or rather before) deletion.
I haven't found a true work around yet, so I'm simply making the sheets I want to delete "disappear" using a for each loop:
Sht.UsedRange.clear
For each shp in sht.Shapes
shp.Delete
Next
For each nm in sht.Parent.Names
if nm.RefersToRange.Parent is sht then nm.Delete
Next
sht.visible = xlSheetVeryHidden
(code is an unchecked draft; eventual errors can be treated with an on error resume next mostly)
It's far from ideal, but it does what I need done (at the cost of more memory, sure). Maybe I should turn this reply into a question and see if someone has a better idea for Excel 2016.
TO DELETE ALL SHEETS WITH OUT "REPORT" SHEET **
Dim NM As String
Dim CTS As Integer
Dim CNT2 As Integer
Dim CNT3 As Integer
CNT3 = 1
CNT2 = 1
CTS = Sheets.Count
Do Until CNT2 = CTS + 1
NM = Sheets(CNT3).Name
If Name = "Report" Then
Range("A1").Select
CNT3 = CNT3 + 1
Else
Sheets(NM).Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
CNT2 = CNT2 + 1
Loop
My question is as follows:
I have given a workbook to multiple people. They have this workbook in a folder of their choice. The workbook name is the same for all people, but folder locations vary.
Let's assume the common file name is MyData-1.xls.
Now I have updated the workbook and want to give it to these people. However when they receive the new one (let's call it MyData-2.xls) I want specific parts of their data pulled from their file (MyData-1) and automatically put into the new one provided (MyData-2).
The columns and cells to be copied/imported are identical for both workbooks. Let's assume I want to import cell data (values only) from MyData-1.xls, Sheet 1, cells B8 through C25 ... to ... the same location in the MyData-2.xls workbook. How can I specify in code (possibly attached to a macro driven import data now button) that I want this data brought into this new workbook. I have tried it at my own location by opening the two workbooks and using the copy/paste-special with links process. It works really well, but It seems to create a hard link between the two physical workbooks. I changed the name of the source workbook and it still worked. This makes me believe that there is a "hard link" between the tow and that this will not allow me to give the target (MyData-2.xls) workbook to others and have it find their source workbook.
To clarify my understanding, each user has a spreadsheet called MyData-1.xls but with varying locations. You would like to send each person a new spreadsheet MyData-2 which will automatically pull in data from range B8:C25 in MyData-1.xls?
There are various options on doing this and below I have provided one way of doing this. In short, the user will open MyData-2, click a button, and the code will search for MyData-1 on their directory, open the workbook, grab the data, paste it into MyData-2, and then close MyData-1.
Sub UpdateWorkbook()
'Identify workbook you would like to pull data from (same for all users)
Dim TargetWorkbook As String
TargetWorkbook = "MyData-1"
'Get the full path of that workbook by searching in a specified directory
Dim TargetPathName As String
TargetPathName = GetFilePath(TargetWorkbook)
'Retrieve data in range B8:C25, copy and paste, then close workbook
Dim TargetRng As Range
Application.ScreenUpdating = False
Workbooks.Open Filename:=TargetPathName
Set TargetRng = Sheets("Sheet1").Range("B8:C25")
TargetRng.Copy Destination:=ThisWorkbook.Worksheets(1).Range("B8:C25")
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Function GetFilePath(TargetWkbook As String) As String
Dim FullFilePath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = "C:\"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
.Filename = TargetWkbook
If .Execute > 0 Then
FullFilePath = .FoundFiles(1)
End If
End With
GetFilePath = FullFilePath
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Function
By way of explanation:
In the sub you first need to specify the name of the workbook MyData-1
The Function GetFilePath will then get the full path name of the workbbok. Note that I have set it to look in the "C:\" drive and you may want to amend that
Once we have the full file path we can easily open the workbook and copy the required range.
Note that the screenupdating is turned off to create the 'illusion' that the workbook has not been opened when the data is copied. Also, I have added a button on the worksheet of MyData-2 to trigger the code i.e. user opens workbook, presses button, and data is imported.
Finally, this code could be augmented significantly and you may want to tweak it. For example, error checking if file not found, searching in multiple directories (e.g C:\, D:)...
Hope this gets you started on the right track
You should use the copy/paste-special for values only:
Private Sub ImportData_Click()
On Error GoTo OpenTheSheet
Workbooks("MyData-1.xls").Activate
GoTo SheetOpen
OpenTheSheet:
Workbooks.Open "MyData-1.xls"
Workbooks("MyData-1.xls").Activate
SheetOpen:
On Error GoTo 0
Workbooks("MyData-1.xls").Worksheets("sheetwhatever").firstRange.Copy
Workbooks("MyData-2.xls").Worksheets("anothersheet").yourRange.PasteSpecial(xlPasteValues)
End Sub
This could be cleaned up a bit, but it's always messy to do file stuff in VBA, I'd probably put the opening code in a function.
Make sure they put the new file in the same directory as the old file.