Add Code to File Opening Q

[Sean]

I have the following code which displays a sheet called E-Splash if
you are not a user listed in named range MyUsers

How can I add to this that a second condition would be applied that if
you are listed also in MyUsers2 then unless A1 in sheet E-Users is
within 35 days of Now() you can't access the file and a message as
follows appears "Time Expired, Please contact etc etc" This would also
mean that if you are in MyUsers and not in MyUsers2 you could access
the file not matter how far Now() is from A1

Thanks



Private Sub Workbook_Open()
Dim myArray As Variant
Dim arName As String
Dim ws As Worksheet
arName = "MyUsers"
myArray = ThisWorkbook.Names(arName).RefersToRange.Value
With Application
If IsError(.Application.Match(.UserName, myArray, 0)) Then
MsgBox "You are NOT Permitted to access this File " & vbCr & _
"" & vbCr & _
"Please Contact Joe Bloggs at " & vbCr & _
"" & vbCr & _
"ABC Inc +0099 1 234567"
Application.DisplayAlerts = False
ThisWorkbook.Close False
Else
For Each ws In Worksheets
ws.Visible = True
Next
Worksheets("E-Splash").Visible = False
Worksheets("E-Users").Visible = xlVeryHidden
Worksheets("E-Sum").Activate
Application.DisplayAlerts = True
End If
End With

End Sub

 

[Bob Phillips]

Private Sub Workbook_Open()
Dim myArray As Variant
Dim arName As String
Dim ws As Worksheet
arName = "MyUsers"
myArray = ThisWorkbook.Names(arName).RefersToRange.Value
If IsError(Application.Match(Application.UserName, myArray, 0)) Then
Call ErrorMsg("You are NOT Permitted to access this File ")
Else
arName = "MyUsers"
myArray = ThisWorkbook.Names(arName).RefersToRange.Value
If Not IsError(Application.Match(.UserName, myArray, 0)) Then
If Worksheets("E-Users").Range("A1").Value < Date Or _
Worksheets("E_Users").Range("A1").Value > Date + 35 Then
Call ErrorMsg("Time expired ")
Else
For Each ws In Worksheets
ws.Visible = True
Next
Worksheets("E-Splash").Visible = False
Worksheets("E-Users").Visible = xlVeryHidden
Worksheets("E-Sum").Activate
Application.DisplayAlerts = True
End If
End If
End If
End Sub

Private Sub ErrorMsg(ByVal msg As String)
MsgBox msg & vbCr & _
"" & vbCr & _
"Please Contact Joe Bloggs at " & vbCr & _
"" & vbCr & _
"ABC Inc +0099 1 234567"
Application.DisplayAlerts = False
ThisWorkbook.Close False
End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Sean]

Private Sub Workbook_Open()
Dim myArray As Variant
Dim arName As String
Dim ws As Worksheet
arName = "MyUsers"
myArray = ThisWorkbook.Names(arName).RefersToRange.Value
If IsError(Application.Match(Application.UserName, myArray, 0)) Then
Call ErrorMsg("You are NOT Permitted to access this File ")
Else
arName = "MyUsers"
myArray = ThisWorkbook.Names(arName).RefersToRange.Value
If Not IsError(Application.Match(.UserName, myArray, 0)) Then
If Worksheets("E-Users").Range("A1").Value < Date Or _
Worksheets("E_Users").Range("A1").Value > Date + 35 Then
Call ErrorMsg("Time expired ")
Else
For Each ws In Worksheets
ws.Visible = True
Next
Worksheets("E-Splash").Visible = False
Worksheets("E-Users").Visible = xlVeryHidden
Worksheets("E-Sum").Activate
Application.DisplayAlerts = True
End If
End If
End If
End Sub

Private Sub ErrorMsg(ByVal msg As String)
MsgBox msg & vbCr & _
"" & vbCr & _
"Please Contact Joe Bloggs at " & vbCr & _
"" & vbCr & _
"ABC Inc +0099 1 234567"
Application.DisplayAlerts = False
ThisWorkbook.Close False
End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)








- Show quoted text -

Thanks Bob, but where do you reference MyUsers2 ? Persumably in line -

Else
arName = "MyUsers"
myArray = ThisWorkbook.Names(arName).RefersToRange.Value

 

[Sean]

Thanks Bob, but where do you reference MyUsers2 ? Persumably in line -

Else
arName = "MyUsers"
myArray = ThisWorkbook.Names(arName).RefersToRange.Value- Hide quoted text -

- Show quoted text -

Bob getting stuck on line

If Not IsError(.Application.Match(.UserName, myArray, 0)) Then

At the .Username with message "invalid or unqualified reference". I
entered .application before, don't get the error message but when I
open the file I just get the E-Splash screen with no message. I would
have expected to get E-Splash with the "Time Expired"message

 

[Sean]

Bob getting stuck on line

If Not IsError(.Application.Match(.UserName, myArray, 0)) Then

At the .Username with message "invalid or unqualified reference". I
entered .application before, don't get the error message but when I
open the file I just get the E-Splash screen with no message. I would
have expected to get E-Splash with the "Time Expired"message- Hide quoted text -

- Show quoted text -

Bob, your line

If Worksheets("E-Users").Range("A1").Value < Date Or _
Worksheets("E_Users").Range("A1").Value > Date + 35
Then

Does this mean if the value in Now() is more than 35 days past A1 then
"Time Expired" etc ?

 

[Dave Peterson]

Back to excel.
Select your range with the names
Insert|Name|Define|
and use the MyUsers as the name of that range.

 

[Dave Peterson]

Bob didn't have a dot in front of Application.

If you're having trouble, I'd copy the text of Bob's message and paste again.
He very rarely makes typos in the code. (And just a few in the descriptive
portion <vbg>.)

 

[Dave Peterson]

Date in VBA is like =today() in a worksheet cell.

It returns the current date--according to your computer's clock.