Solved: Setting passwords in Excel to control data access.

[cssamerican]

I have a recently been redoing one of my spreadsheets. It originally was basically a database program than ran using loops and arrays. Needless to say, it began to bog down and was a real pain to keep updated. My new version retrieves data from worksheets with a SQL statement using DAO. The report feature currently has two reports a detailed one that shows individual user activity within a budget code, and a summary report that shows a summary of departmental activity for all budget codes.

The goal is to have a department head enter a password when they open up the workbook. Then that department head can only pull data that corresponds to budget codes that they are responsible for. When they choose to do a detail report I want for them to only be able to see/select budget codes from a combo box that they are in charge of. Then when they choose the summary report I would like it to display a summary of all departmental activity for all the budget codes that they are responsible for. Please note that each department head could be responsible for multiple budget codes. This doesn?t have to be really secure, I am not dealing with hackers or anything like that.

I had all this working when I was retrieving my data the hard way, but for some reason I am having a hard time figuring out to control access to the summary report when using this better method of data aquisition. The way I am controlling the access to the detailed reports is with the following code:
Private Sub UserForm_Initialize()
Dim NBC As Integer
Dim CounterOne As Integer
NBC = 151
If Worksheets(2).Cells(1, 5) = "Master" Then
For CounterOne = 1 To NBC
cbBudget_Code.AddItem Worksheets(2).Cells(CounterOne, 2).Value
Next
Else
For CounterOne = 1 To NBC
If Worksheets(2).Cells(CounterOne, 3).Value = Worksheets(2).Cells(1, 5) Then
cbBudget_Code.AddItem Worksheets(2).Cells(CounterOne, 2).Value
End If
Next
End If
End Sub

I know it is a pretty pathetic excuse for password protection but the idea behind it works well enough for what I am using it for. My one complaint is I would prefer to not have to manually keep up with the number of budget codes if possible. But as of now I can live with it if I can get some type of system to control the summary reports.

I am not sure if this is necessary, but this is my new code that is retrieving the data and putting it on the page:
Sub DAO_Report_Engine()
Const stExtens As String = "Excel 8.0;HDR=Yes;IMEX=1"

'Variables for DAO.
Dim DAO_ws As DAO.Workspace
Dim DAO_db As DAO.Database
Dim DAO_rs As DAO.Recordset
Dim strDb As String
Dim strSQLSummary As String
Dim strSQLDetail As String

strSQLSummary = "SELECT [Sheet2$].Department, " & vbNewLine & _
"[Sheet2$].Department_Head, " & vbNewLine & _
"[Sheet2$].Department_Code, " & vbNewLine & _
"SUM([Sheet1$].Centralized), " & vbNewLine & _
"SUM([Sheet1$].Paper), " & vbNewLine & _
"SUM([Sheet1$].IDCard), " & vbNewLine & _
"SUM([Sheet1$].Print_Management), " & vbNewLine & _
"SUM([Sheet1$].Local+[Sheet1$].Network) AS 'NCPrints', " & vbNewLine & _
"SUM([Sheet1$].Color) AS 'CPrints', " & vbNewLine & _
"SUM(SNXXXXX01+SNXXXXX02+SNXXXXX03+SNXXXXX04+SNXXXXX05+" _
& "SNXXXXX06+SNXXXXX07+SNXXXXX08+SNXXXXX09+SNXXXXX10+SNXXXXX11+"_
& "SNXXXXX12+SNXXXXX13+SNXXXXX14+SNXXXXX15+SNXXXXX16) " _
& "AS 'CCopies' " & vbNewLine & _
"FROM [Sheet2$] " & vbNewLine & _
"INNER JOIN [Sheet1$]" & vbNewLine & _
"ON [Sheet2$].Department_Code=[Sheet1$].Budget_Code " & vbNewLine & _
"GROUP BY Department, Department_Head, Department_Code " & vbNewLine & _
"ORDER BY Department_Code"

strSQLDetail = "SELECT Last_Name, " & vbNewLine & _
"First_Name, " & vbNewLine & _
"Budget_Code, " & vbNewLine & _
"SUM(Centralized), " & vbNewLine & _
"SUM(Paper), " & vbNewLine & _
"SUM(IDCard), " & vbNewLine & _
"SUM(Print_Management), " & vbNewLine & _
"SUM(Local+Network) AS 'NCPrints', " & vbNewLine & _
"SUM(Color) AS 'CPrints', " & vbNewLine & _
"SUM(SNXXXXX01+SNXXXXX02+SNXXXXX03+SNXXXXX04+SNXXXXX05+" _
& "SNXXXXX06+SNXXXXX07+SNXXXXX08+SNXXXXX09+SNXXXXX10+SNXXXXX11+"_
& "SNXXXXX12+SNXXXXX13+SNXXXXX14+SNXXXXX15+SNXXXXX16) " _
& "AS 'CCopies' " & vbNewLine & _
"FROM [Sheet1$] " & vbNewLine & _
"WHERE Budget_Code = '" & UserForm1.cbBudget_Code.Value & "' " & vbNewLine & _
"GROUP BY Last_Name, First_Name, Budget_Code"

'Variables for Excel.
Dim wbBook As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim rnTarget As Range
Dim rsCounter As Integer
Set wbBook = ActiveWorkbook
Set wsTarget = wbBook.Worksheets("Reports")
With wsTarget
.Cells.ClearContents
.Range("D6").Value = "Centralized"
.Range("D7").Value = "Production"
.Range("E7").Value = "Paper"
.Range("F7").Value = "ID Card"
.Range("G6").Value = "Print"
.Range("G7").Value = "Management"
.Range("H6").Value = "Non-CPrints"
.Range("H7").Value = "Rate is at .0056?"
.Range("I6").Value = "CPrints"
.Range("I7").Value = "Rate is at 8?"
.Range("J6").Value = "CCopies"
.Range("J7").Value = "Rate is at 8?"
.Range("K6").Value = "Cost of Impressions"
.Range("K7").Value = "At Current Rates"
Set rnTarget = .Range("A8")
End With
strDb = wbBook.FullName

'Instantiate the DAO objects.
Set DAO_ws = DBEngine.Workspaces(0)
Set DAO_db = DAO_ws.OpenDatabase(strDb, False, True, stExtens)
If UserForm1.strReport = "Detail" Then
Set DAO_rs = DAO_db.OpenRecordset(strSQLDetail, dbOpenForwardOnly)
With wsTarget
.Range("A7").Value = "Last Name"
.Range("B7").Value = "First Name"
.Range("C7").Value = "Budget Code"
End With
ElseIf UserForm1.strReport = "Summary" Then
Set DAO_rs = DAO_db.OpenRecordset(strSQLSummary, dbOpenForwardOnly)
With wsTarget
.Range("A7").Value = "Department"
.Range("B7").Value = "Department Head"
.Range("C7").Value = "Budget Code"
End With
Else
MsgBox "No reports selected.", vbCritical
Exit Sub
End If

'Write the Recordset to the target range.
rnTarget.CopyFromRecordset DAO_rs

'Close the instances.
DAO_rs.Close
DAO_db.Close
DAO_ws.Close

'Release objects from memory.
Set DAO_rs = Nothing
Set DAO_db = Nothing
Set DAO_ws = Nothing
End Sub
Any advice would be appreciated. If you need me to post upload either one of my files that is fine, but I will need some time to dummy up the data.

[mdmackillop]

Assuming that users are logged on to your system, could you use Application.Username to determine your report access? I suppose some password authentication could also be added.
Regards
MD

[cssamerican]

All the data is in a single excel workbook, and that workbook is being distributed to the end user. Every month the file is saved for that month and year and I keep it for my records. At beginning of each new month all the data is deleted and I import the new data for that month into the worksheet. So, there is never more than one months data in the workbook, this keeps the file size from being an issue when the workbook is distributed. It is done like this because there were issues with connecting to an external database. Because of this I don't think I can use what you are refering to, I believe all the password stuff is going to have to within my application.

[lucas]

The goal is to have a department head enter a password when they open up the workbook. Then that department head can only pull data that corresponds to budget codes that they are responsible for.

Does this mean restrict their access to one sheet?

[cssamerican]

All users will only see one sheet and that sheet is the report sheet. But the password is so when they run the query it isn't going to write all 150 department totals to the report sheet. Instead it will only write what they have access to. For example, let us say you are in charge of all the budget codes of the Science Departments. I only what you to see the totals for:
Chemistry
Biology
Physics
When it writes the recordset to the sheet. You shouldn't see totals for the English department. Understand?

[lucas]

I think I understand but have no easy solution for you. There are some really sharp people here and someone will come along to help you soon I'm sure.

As a workaround would it be possible to:
have a detail and summary sheet xlveryhidden for each dept. and use a password to unhide just for that dept from a dashboard sheet(login sheet?!) From there they can run code that you set up specifically for that dept....

[cssamerican]

As a workaround would it be possible to:
have a detail and summary sheet xlveryhidden for each dept. and use a password to unhide just for that dept from a dashboard sheet(login sheet?!) From there they can run code that you set up specifically for that dept....
Not really. The departments come and go too quickly for that. Every time the college gets a grant a new budget code is created. So, it would require a ton of work to maintain, and that is something I am trying to alleviate with my newer version. Plus If the Dean of Chemisty and Physics wants to look and see how much his Budget Codes are being assessed for printing and copying I want it to where it is diplayed all on one sheet. If next month he is no longer over Chemistry I just want to be able to change an his name to a new name in a table instead of having to worry about changing code.

[mdmackillop]

If you could post your "sample" I think that would be useful, also a simple demo of what you would like to see in a final report.
Regards
MD

[cssamerican]

Ok, here is my file.
The master password is "word", this will unhide all the sheets. There are four other limited access passwords on the password sheet. If you use these you can see how this affects the detail report.

I want the same effect on the summary report. Only show the summary of departments they have access to in the detail report.

[mdmackillop]

What's the password for the VBA Project?

[cssamerican]

none4you

Sorry about that. I have been thinking about this and I know one place where I went wrong. I was trying to pull all the data then restrict what the user saw. Perhaps the better way would be to use the password table in conjuction with the other tables through a join of some type and modify what the SQL script pulled on the fly. Is this approach a sound and doable idea?

[cssamerican]

Okay this is where I am at currrently. I am trying to join three tables, one of which is Sheet3, a password table. What I am attempting to do is only pull records when the value of password field is equal to the value of the cell Worksheets(2).Cells(1, 5).
strSQLSummary = "SELECT [Sheet2$].Department, " & vbNewLine & _
"[Sheet2$].Department_Head, " & vbNewLine & _
"[Sheet2$].Department_Code, " & vbNewLine & _
"SUM([Sheet1$].Centralized), " & vbNewLine & _
"SUM([Sheet1$].Paper), " & vbNewLine & _
"SUM([Sheet1$].IDCard), " & vbNewLine & _
"SUM([Sheet1$].Print_Management), " & vbNewLine & _
"SUM([Sheet1$].Local+[Sheet1$].Network) AS 'NCPrints', " & vbNewLine & _
"SUM([Sheet1$].Color) AS 'CPrints', " & vbNewLine & _
"SUM(SNXXXXX01+SNXXXXX02+SNXXXXX03+SNXXXXX04+SNXXXXX05+" _
& "SNXXXXX06+SNXXXXX07+SNXXXXX08+SNXXXXX09+SNXXXXX10+SNXXXXX11+" _
& "SNXXXXX12+SNXXXXX13+SNXXXXX14+SNXXXXX15+SNXXXXX16) " _
& "AS 'CCopies' " & vbNewLine & _
"FROM [Sheet1$] " & vbNewLine & _
"INNER JOIN ([Sheet2$]" & vbNewLine & _
"INNER JOIN [Sheet3$]" & vbNewLine & _
"ON [Sheet2$].Department_Head=[Sheet3$].User_Name) " & vbNewLine & _
"ON [Sheet1$].Budget_Code=[Sheet2$].Department_Code " & vbNewLine & _
"WHERE [Sheet3$].Password = '" & Worksheets(2).Cells(1, 5).Value & "' " & vbNewLine & _
"GROUP BY Department, Department_Head, Department_Code " & vbNewLine & _
"ORDER BY Department_Code"
As of right now it doesn't pull any records, and I am not getting any errors either. So, I am not sure why it isn't working. If you want to test my new code the only thing that I have modified is this SQL statement, so you only need to download the file I already posted and just paste this new statement over the old one.

[mdmackillop]

I've not had time yet to look at this, but my initial thought was to filter data based on username/pasword to a temporary sheet from which the report would be created.
Regards
MD

[cssamerican]

This approach worked once I realized my comparison data didn't have the same capitalization. Thanks for the help.

[cssamerican]

This thread can be marked solved.

Just in case anyone looks this up and wants to see what I did to get it to work the way I wanted, I figured I would post my final working version of what I did. The passwords are as follows:
Project password: none4you
Worksheet passwords:
pass01
pass02
pass03
pass04
word
pw
The "pass" passwords would be what a department head would be issued. The "pw" password would be an accountant's password and the "word" password would be for me, the administrator.

This really isn't important, but if someone wants to chime in I would appreciate it since I am just learning VB and all.
Dim wbBook As Workbook
Dim rsArray() As Variant
Dim rsCount As Integer
Dim Row As Integer
Dim wsudTarget As Worksheet
Dim wsddTarget As Worksheet
Dim wspdTarget As Worksheet
Dim wsrTarget As Worksheet
Set wbBook = ActiveWorkbook
Set wsudTarget = wbBook.Worksheets("User_Data")
Set wsddTarget = wbBook.Worksheets("Department_Data")
Set wspdTarget = wbBook.Worksheets("Password_Data")
Set wsrTarget = wbBook.Worksheets("Reports")
Select Case Pass(LogInForm.tbPassword.Value)
Case "Administrator"
wsudTarget.Visible = xlSheetVisible
wsddTarget.Visible = xlSheetVisible
wspdTarget.Visible = xlSheetVisible
wsrTarget.Visible = xlSheetVisible
wsrTarget.LaunchApp.Visible = True
Case "Accounting"
wsddTarget.Visible = xlSheetVisible
wspdTarget.Visible = xlSheetVisible
wsrTarget.Visible = xlSheetVisible
Worksheets("Reports").LaunchApp.Visible = True
Case Else
For Row = 2 To rsCount
If LogInForm.tbPassword.Value = wspdTarget.Cells(Row, 2) Then
wsrTarget.Visible = xlSheetVisible
Worksheets("Reports").LaunchApp.Visible = True
End If
Next
End Select
If I change Worksheets("Reports").LaunchApp.Visible = True to wsrTarget.LaunchApp.Visible = True I get the following error:
Method or data member not found. Is there a reason for this that I might not be aware of?

[lucas]

Hello cssamerican,
Thanks for posting your solution. Many folks get their answers and forget to share what they end up doing with those of us following the thread. Looks like it does as you wished but I still get 2 password input boxes when I close the book. Other than that it looks pretty good.

will mark this solved for you.

[cssamerican]

Hello cssamerican,
Thanks for posting your solution. Many folks get their answers and forget to share what they end up doing with those of us following the thread. Looks like it does as you wished but I still get 2 password input boxes when I close the book. Other than that it looks pretty good.

will mark this solved for you.
No prob. The problem you seem to be having I have not experienced. Strange. Maybe because I am using Excel97? Hmm...Better test this on newer version of Excel just to make sure I am not going to have any unexpected problems when I distribute the file.:sleuth: