Solved: VBA Reference Protected Workbook

[fredlo2010]

Hello guys,

I created a spread sheets that uses several Vlookps and Matches. Also in the spreadsheet I have some codes that basically copy and paste data from a place to the other.

Now the workbook my workbook is linked to is password protected so user cannot access tons of information at the same time unless they use my spreadsheet.

Everything was working perfectly until I protected the linked workbook. When I opened my master spreadsheet It prompted me to enter a password. Every time I sun my macros I have to reenter them several times.

Is there other way to protect my database workbook so I don't have these issues. Like a workbook event to prompt a password. But instead of the Excel protection so communication itself is not affected and its only workbook_open even that triggers it.

Thanks a lot guys for the help.

I am open to ideas here

[fredlo2010]

BTW when I open the workbook that has the link. I have to enter the password 4 times in a row. Why?

[fredlo2010]

Hi guys,

Is this so hard? How can I do this?

I cannot go further with my project without a solution

Thanks a lot :)

[GTO]

Hello guys,

I created a spread sheets that uses several Vlookps and Matches. Also in the spreadsheet I have some codes that basically copy and paste data from a place to the other.

Now the workbook my workbook is linked to is password protected so user cannot access tons of information at the same time unless they use my spreadsheet.

Everything was working perfectly until I protected the linked workbook. When I opened my master spreadsheet It prompted me to enter a password. Every time I sun my macros I have to reenter them several times.

Is there other way to protect my database workbook so I don't have these issues. Like a workbook event to prompt a password. But instead of the Excel protection so communication itself is not affected and its only workbook_open even that triggers it.

Thanks a lot guys for the help.

I am open to ideas here

At least for me, while I believe you have the links in the user accessable workbook, and I assume the macros are also in the user's workbook, I cannot tell what the macros are doing.

Could you create to workbooks, 'Source.xls' (the one that is passworded) and 'User.xls' with a few simple links and at least enough code to replicate all the warnings/password required's you are getting?

We don't need to see any sensitive data, but the operations/links/macros should accurately replicate the behaviour experienced.

You can zip the workbooks, as only on attachment is allowed per post.

Mark

[fredlo2010]

Thanks for the help. I am sorry I took so long but it has been a long day.

OK so I created the workbook that does the following:

1.It shows a welcome Splash Screen wen the User's (main workbook) is open.

2.Also in open event there is a code that copies all the formulas in the workbook. These contain the link reference. I do this because every time I close the workbook I convert all cells to values. This reduces the size of my workbook that has been increased by the precedence of the linked(Source workbook)

PS: I totally forgot the password is "1"
Thanks

Here is the sample

8462

[fredlo2010]

Hi guys,

Have you have time to look at this? :(

Thanks

[Kenneth Hobs]

In ThisWorkbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
GetReport
ThisWorkbook.Save
Workbooks("Source.xlsx").Close False
End Sub

Private Sub Workbook_open()
Dim s As String
s = "Source.xlsx"
Welcome.Show
'ThisWorkbook.UpdateLinks = xlUpdateLinksNever
If Not IsWorkbookOpen(s) Then
Workbooks.Open ThisWorkbook.Path & "\" & s, Password:="1", UpdateLinks:=xlUpdateLinksNever
ThisWorkbook.Activate
End If
PopulateFormulas
End Sub

In the Reporting module:
Sub PopulateFormulas()
'this will repopulate all my formulas in the worksheet
Range("B2:B25").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],'[Source.xlsx]Sheet1'!R1C1:R69C7,2,FALSE),"""")"
Range("C2:C25").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],'[Source.xlsx]Sheet1'!R1C1:R69C7,3,FALSE),"""")"
Range("D2:D25").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-3],'[Source.xlsx]Sheet1'!R1C1:R69C7,4,FALSE),"""")"
Range("E2:E25").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-4],'[Source.xlsx]Sheet1'!R1C1:R69C7,5,FALSE),"""")"
Range("F2:F25").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-5],'[Source.xlsx]Sheet1'!R1C1:R69C7,6,FALSE),"""")"
Range("G2:G25").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-6],'[Source.xlsx]Sheet1'!R1C1:R69C7,7,FALSE),"""")"
Range("H2:H25").FormulaR1C1 = "=IFERROR(RC[-1]*25^RC[-1],0)"
Range("I2:I25").FormulaR1C1 = "=IFERROR((RC[-2]-RC[-1])/RC[-2],0)"
End Sub

Sub GetReport()
Range("B2:I25").Value = Range("B2:I25").Value
End Sub

Function IsWorkbookOpen(stName As String) As Boolean
Dim Wkb As Workbook
On Error Resume Next ' In Case it isn't Open
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then IsWorkbookOpen = True
'Boolean Function assumed To be False unless Set To True
End Function

[fredlo2010]

Hi Keneth,

Thanks for the help. But It does not work I will have to enter the password. Also Will the Source workbook stay open? People can just switch screen ans access the data.

Thanks

[Kenneth Hobs]

If it did not work, I would not have posted it. We can hide the source if needed.

Another method is to use ADO and just enter the result of a query as a value.

[fredlo2010]

Hi,

Apparently I was doing something wrong. I tried to recreate it at work and it was not working. I tried it at home and works perfectly.

I have two issues unsolved still:

1. The source workbook stays open and visible. (anyone can access the information. in my sample there is not sensitive information but in the real deal there is going to be sensitive information like, address, accounts, prices)

2. When I close the User's workbook. Everything is closed but the Excel windows stays open

Thanks a lot for the help

[Kenneth Hobs]

To hide the source workbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
GetReport
ThisWorkbook.Save
Workbooks("Source.xlsx").Close False
End Sub

Private Sub Workbook_open()
Dim s As String
s = "Source.xlsx"
Welcome.Show
'ThisWorkbook.UpdateLinks = xlUpdateLinksNever
If Not IsWorkbookOpen(s) Then
Workbooks.Open ThisWorkbook.Path & "\" & s, Password:="1", UpdateLinks:=xlUpdateLinksNever
End If

Workbooks("Source.xlsx").Windows(1).Visible = False

ThisWorkbook.Activate
PopulateFormulas
End Sub

[fredlo2010]

Hi Kenneth,

This works perfectly. The only issue I am having now its that Excel stays open after I close the workbook.

I tried this:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
GetReport
ThisWorkbook.Save
Workbooks("Source.xlsx").Close False
Application.Quit

End Sub

Private Sub Workbook_open()
Dim s As String
s = "Source.xlsx"
Welcome.Show
'ThisWorkbook.UpdateLinks = xlUpdateLinksNever
If Not IsWorkbookOpen(s) Then
Workbooks.Open ThisWorkbook.Path & "\" & s, Password:="1", UpdateLinks:=xlUpdateLinksNever
End If

Workbooks("Source.xlsx").Windows(1).Visible = False

ThisWorkbook.Activate
PopulateFormulas
End Sub


But it does not help. Any ideas?

Again thanks a lot for your help

[Kenneth Hobs]

I have not tested this:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, j As Integer
GetReport
ThisWorkbook.Save
Workbooks("Source.xlsx").Close False

For i = 1 To Workbooks.Count
If Workbooks(i).Visible = True Then j = j + 1
Next i
If j = 1 Then
Application.Quit
Else
ThisWorkbook.Close False
End If
End Sub

[fredlo2010]

Hi,

Its giving me an error:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Integer, j As Integer
GetReport
ThisWorkbook.Save
Workbooks("Source.xlsx").Close False

For i = 1 To Workbooks.Count
If Workbooks(i).Visible = True Then j = j + 1 ' error here
Next i
If j = 1 Then
Application.Quit
Else
ThisWorkbook.Close False
End If
End Sub

Is there another way of doing this? Its frustrating :(

[GTO]

Hi Fred,

I'm at home (Excel2000), but if I am understanding IFERROR(), you appear to want to return the values in the adjacent columns to where we find the lookfor values in the source workbook. Fortunately I downloaded your attachments at work and did SaveAs to .xls format, as I did not have time to have a stab at it at the time.

I may be missing something, but how about opening the source workbook in a new/hidden instance of Excel, and returning just the values wanted where we find the lookfor value?

In a Standard Module:
Option Explicit

Sub PopulateRange()
Dim oExcel As Excel.Application
Dim wb As Workbook
Dim wks As Worksheet
Dim rngLookin As Range
Dim rngSource As Range
Dim rngVals2LookFor As Range
Dim Cell As Range
Dim n As Long
Dim lRow As Long
Dim Path As String

Const FNAME As String = "Source1.xls" '<---Change to suit

'// Choose the path we look for the source wb in //
Path = ThisWorkbook.Path & "\"

'// Check if the file exists //
If Not Dir(Path & FNAME, vbNormal) = vbNullString Then

'// Not great, but we probably want to handle any error //
On Error GoTo Bail

'// If wanting to assure no "access" (at least "visible" to user), maybe open //
'// the wb in another instance. //
Set oExcel = New Excel.Application
With oExcel

'// Change to FALSE once tested //
.Visible = False

'// Set a reference to wb and sheet //
Set wb = .Workbooks.Open(Filename:=Path & FNAME, ReadOnly:=True, Password:=1)
Set wks = wb.Worksheets("Sheet1")

'// Hard coded ranges, you may wish to use .Find to see how many rows of //
'// data there are. //
Set rngLookin = wks.Range("A1:A69")
Set rngSource = wks.Range("B1:G69")
Set rngVals2LookFor = ThisWorkbook.Worksheets("Data2").Range("A2:A25")

For Each Cell In rngVals2LookFor.Cells
On Error Resume Next
lRow = 0
lRow = Application.Match(Cell.Value, rngLookin, 0)
On Error GoTo 0

If lRow > 0 Then
Cell.Offset(, 1).Resize(, 6).Value = Application.Index(rngSource, lRow, 0)
Else
Cell.Offset(, 1).Resize(, 6).ClearContents
End If
Next

wb.Close False
.Quit
End With
Set oExcel = Nothing
Else
MsgBox "Source not available", vbInformation, vbNullString
Exit Sub
End If
Exit Sub
Bail:
With oExcel
For Each wb In .Workbooks
wb.Close False
Next
.Quit
End With

Set oExcel = Nothing
End Sub

Hope I'm not misunderstanding IFERROR()

Mark

[fredlo2010]

Hello guys,

Thanks a lot for all the efforts and help.

The IFERROR is there to handle any value that I cannot find in the source workbook.

Yesterday I was reading another post, that has nothing to do with this, but I gave me an idea on how to work this out. This is what I did to go around my issue here:

First I changed my source workbook from .xlsx to .xlsm. Every time the source.xlsm file is open the user will face a blank sheet and a user form that will ask for a password. All the sheets with data are very hidden. If the password is correct then all the sheets will be visible.

Code in the OK button of my log in form

Private Sub CommandButton1_Click()

Dim sh As Worksheet

Application.ScreenUpdating = False

If TextBox1.Value = "1" Then

For Each sh In ThisWorkbook.Sheets

If sh.Name <> "Blank" Then
sh.Visible = True
End If
Next

'add the code for the extra security
With Sheets("Blank").Range("L12")
.Value = "1"
.Font.ThemeColor = xlThemeColorDark1
.Font.TintAndShade = 0
End With

LoginForm.Hide
Else
MsgBox "Incorrect password has been entered", vbOKOnly + vbCritical, "Login Fail Error"
End If

Application.ScreenUpdating = True
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If CloseMode = 0 Then
Cancel = True
MsgBox "Operation not Permited", vbCritical
End If

End Sub


Also there will be a value entered in the "Blank" sheet to make sure the sheets are changed to visible through the code, if for some reason the sheets are changed to visible through any other method (not sure what that would be, but I know there is password crackers out there that can strip out the protection of my VBA project) then the sheets will be deleted Automatically.

Private Sub Worksheet_Activate()

If Sheets("Blank").Range("L12").Value <> "1" Then

Application.DisplayAlerts = False
Me.Delete

End If

End Sub


And finally my code under ThisWorkBook

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim sh As Worksheet

For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Blank" Then
sh.Visible = xlVeryHidden
End If
Next

Sheets("Blank").Range("L12").Value = vbNullString
ThisWorkbook.Save
End Sub


Private Sub Workbook_Open()

LoginForm.Show

End Sub

Its a lot ah? Did I miss anything?

Again thanks a lot for your help guys.