Password Protection solution 2

[MarkBeck]

Hi

I have a workbook that has several users, all of whom have their own input sheet. I need to restrict them to be able to only view their own sheet.

I have a Users table, defining UserName, Password, WorksheetName.

The Welcome sheet asks for input of username & pasword, and returns (index+match formula) in cell "B6" the name of the users sheet, or "Error!" if the UserName & Password combination is wrong.

I would like to create 2 macros;

Macro A) renders ALL SHEETS EXCEPT "Welcome sheet" invisible upon Open (Event based)

Macro B) Makes visible the sheet that is named in "B6" above.

Thanks

Mark

 

[SkipVought]

Hi,

Sheets can be VeryHidden ONLY in VB, either in the editor or via code.

When the workbook opens, only the INTRO sheet is visible. When the user validates, your code hides the INTRO sheet and makes visible the USER'S authorized sheet(s).

When the workbook closes, the Workbook_Close event, makes visible the INTRO sheet and hides all other sheets before saving.

Skip,
[sub]
[red][/red]
[/sub]

 

[MarkBeck]

But i need the CODE.

 

[SkipVought]

"But i need the CODE."

Don't we all!

Check out the Visible property of the Worksheet.

Check out WorkBook Events.

When you've written some code and need some TIPS, post you code and questions.



Skip,
[sub]
[red][/red]
[/sub]

 

[DirkStruan]

Following from Skips advice about xlVeryHidden....

Sub hide()
Sheets("sheet1").Visible = xlVeryHidden
End Sub

Sub unhide()
Sheets("Sheet1").Visible = True
End Sub

You can go through each sheet name and hide them one at a time or cycle through them:

Sub hide2()
For Each x In Sheets
    If x.Name <> "Sheet3" Then x.Visible = xlVeryHidden
Next x
End Sub

Sub unhide2()
For Each x In Sheets
    If x.Visible = xlVeryHidden Then x.Visible = True
Next x
End Sub

Dirk

Everything useful perishes through use....Should I not rejoice at being useless?

 

[MarkBeck]

Thanks Dirk for your code. The For Each statement shortened and simplified my elaborate sheet identifier & hiding them.

Skip.
I HAVE written the code. All i was missing was the short version of hiding all except the Welcome sheet, which Dirk did.

The other part i am missing is the connection between the sheet result STRING (returned in the Welcome sheet, based on the UserName & password entry) which is displayed in cell "B6" which i Named as a Range "SheetSelector", and the VBA code identifying that STRING as a sheet.

Here is the code i have written, that does not work.

Sub SelectSheet()
Sheets.Range."SheetSelector".Visible = True
End Sub


I would appreciate your help on this matter.

Mark

 

[SkipVought]

Sub SelectSheet()
    with Sheets("SheetSelector")
      .Visible = xlSheetVisible
      .Activate
    end with
End Sub

Skip,
[sub]
[red][/red]
[/sub]

 

[MarkBeck]

Dubugger kickes in.

>with Sheets("SheetSelector")
There is no sheet called "SheetSelector". Instead this is a named range (of the single cell "B6") that displays the sheet name required to make visible. The result in "SheetSelector" would be "WJ", "AJ" or "FS" (All are sheet names).

My problem is how to encode the VALUE displayed in the "SheetSelector" Range as a SheetName. In an excel formula i would use the INDIRECT function to achieve this.

 

[PHV]

Perhaps this ?
With Sheets(Range("SheetSelector").Value)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[MarkBeck]

Thank you PHV! It works.

 

[HorseGoose]

What I have done in the past is give each user a password which is derived from an algoritim and their username that way only the user (who is logged in) with teh right password can use the workbook and it opens at the right worksheet while hidign the others.

You need to have a module for generating the passwords from the usernames and then you can keep a list of usernames and passwords next to each other. Here is the code I have used for doing this, i am happy to send anyone the workbook if they are interested.

'
'
'
' this Module the code for the program
Option Explicit

Sub auto_open()
    Application.ErrorCheckingOptions.NumberAsText = False
    Application.EnableEvents = True
End Sub

Sub auto_close()
    Application.ErrorCheckingOptions.NumberAsText = True
    Application.EnableEvents = True
End Sub

Function gen_pw(var_pw As String)
    ' this proc creates a function which generates a password from a string
    ' generates a password from a given string which is reproducable.
    Dim var_num As Double
    Dim loops As Integer
    var_num = 1
    
    ' make sure there is something to do
    Select Case var_pw
        Case Is <= " "
            Exit Function
        Case Else
    End Select
    Dim var_len As Integer
    
    var_len = Len(var_pw)
    
    For loops = 1 To var_len
        Select Case Right(Left(var_pw, loops), 1)
            Case Is = "A", "a"
                var_num = var_num * 0.005489
            Case Is = "B", "b"
                var_num = var_num * 2789
            Case Is = "C", "c"
                var_num = var_num * 312
            Case Is = "D", "d"
                var_num = var_num * 77
            Case Is = "E", "e"
                var_num = var_num * 179337
            Case Is = "F", "f"
                var_num = var_num * 24
            Case Is = "G", "g"
                var_num = var_num * 56
            Case Is = "H", "h"
                var_num = var_num * 157862
            Case Is = "I", "i"
                var_num = var_num * 9234
            Case Is = "J", "j"
                var_num = var_num * 110
            Case Is = "K", "k"
                var_num = var_num * 880
            Case Is = "L", "l"
                var_num = var_num * 3.1423568
            Case Is = "M", "n"
                var_num = var_num * 13
            Case Is = "N", "n"
                var_num = var_num * 145
            Case Is = "O", "o"
                var_num = var_num * 911985
            Case Is = "P", "p"
                var_num = var_num * 125
            Case Is = "Q", "q"
                var_num = var_num * 0.015
            Case Is = "R", "r"
                var_num = var_num * 187
            Case Is = "S", "s"
                var_num = var_num * 982
            Case Is = "T", "t"
                var_num = var_num * 0.1897
            Case Is = "U", "u"
                var_num = var_num * 117
            Case Is = "V", "v"
                var_num = var_num * 0.257
            Case Is = "W", "w"
                var_num = var_num * 465
            Case Is = "X", "x"
                var_num = var_num * 18741
            Case Is = "Y", "y"
                var_num = var_num * 55555
            Case Is = "Z", "z"
                var_num = var_num * 2874
            Case Else
                var_num = var_num * 8
        End Select
    Next loops
    
    gen_pw = Left(var_num, 10)

End Function

The gen_pw input is always the username of the person on their PC to get that use this.....

Sub auto_open()
    Range("$A$1") = Environ("Username")
End Sub

and put it in a workbook in it's own module. When the workbook is opened the username is displayed.

This may be a bit long winded but it works for me.

CHeers

HG

 

[SkipVought]

Try this instead

Select Case UCase(Mid(var_pw, loops, 1))
            Case Is = "A"
...

Skip,
[sub]
[red][/red]
[/sub]

 

[MarkBeck]

Thanks HG. I will consult your sheet later.

Skip/PHV
Another refinement question

This is my code;

Sub OpenTC()
    Sheets("Welcome").Activate
        If Range("SheetSelector") = "Error!" Then
          MsgBox ("Username Password error!")
        Else
         With Sheets(Range("SheetSelector").Value)
         .Visible = xlSheetVisible
         .Activate
         End With
       End If
End Sub

I tried to incorporate this

Sheets("Welcome").Select
  Range("C2:C3").Select     'Area for UserName & Password
    Selection.ClearContents

But that sends me continuously back to the welcome sheet. Yet i need the range populated to guide me to the correct sheet.
How do I erase the Username Password?

Mark

 

[SkipVought]

Sheets("Welcome").Select  
Sheets(SomeOtherSheet).Range("C2:C3").ClearContents

Skip,
[sub]
[red][/red]
[/sub]

 

[MarkBeck]

Debugger
Error code 9
Subscript out of range

However it does the job.

Can i get rid of error code?

 

[SkipVought]

Did you REPLACE SomeOtherSheet with whatever sheet the data of interest is on???

Skip,
[sub]
[red][/red]
[/sub]

 

[MarkBeck]

No. I thought it was a VBA Name.

But, I would like to make myself clearer;

Range ("C2:C3") is on the welcome sheet. Its contents populate the Range ("SheetSelector"), which in turn activates the relevant User Sheet.
So I MUST HAVE ("C2:C3") populated to get to my desired sheet. Once THERE, i need to clear the Username Password contents in the welcome sheet WHILST REMAINING IN THE SAME SHEET!, Otherwise once the contents is cleared i have lost the director in Range ("SheetSelector") and cant return to the desired sheet.

here is my code again;

Sub OpenTC()
    Sheets("Welcome").Activate
        If Range("SheetSelector") = "" Then
          MsgBox ("Please enter Username & Password!")
          GoTo myend
        Else
        If Range("SheetSelector") = "Error!" Then
          MsgBox ("Username Password error!")
        Else
          With Sheets(Range("SheetSelector").Value)
         .Visible = xlSheetVisible
         .Activate
         End With
       End If
       End If
    Sheets("Welcome").Select
    Sheets("Welcome").Range("C2:C3").ClearContents
End Sub

Incidentally; can you correct the string in GoTo "myend"?

Thanks

Mark

 

[SkipVought]

sub ClearWelcome()
    Sheets("Welcome").Range("C2:C3").ClearContents
end sub

Call ClearWelcome from wherever.

Sub OpenTC()
    Sheets("Welcome").Activate
        If Range("SheetSelector") = "" Then
          MsgBox ("Please enter Username & Password!")
          GoTo myend
        Else
        If Range("SheetSelector") = "Error!" Then
          MsgBox ("Username Password error!")
        Else
          With Sheets(Range("SheetSelector").Value)
         .Visible = xlSheetVisible
         .Activate
         End With
       End If
       End If
    ClearWelcome
End Sub]

Skip,
[sub]
[glasses] [b][red][/red][/b]
[b][/b] [tongue][/sub]

 

[MarkBeck]

Will that clear the value calculated in RangeSelector (also on the Welcome sheet) as well? This formula has to stay in tact.

The welcome sheet only has THREE populated cells;

C2 'to be cleared
C3 'to be cleared
C5 ' NOT cleared (Calculated value based on C2 & C3)

 

[SkipVought]

C5 is NOT cleared in this statement, is it?

sub ClearWelcome()
    Sheets("Welcome").Range("C2:C3").ClearContents
end sub

It does exactly what you requested.

This is getting tiresome!



Skip,
[sub]
[red][/red]
[/sub]