Password protect individual spreadsheet tabs

[markster]

hello I'm working on Excel 2000. Is it possible to password protect individual spreadsheet tabs so they can't be read without a password? I have a work book and one of the tabs has everybody's salaries on it and don't want people to be able to see. I want to circulate the workbook in it's entirety buy don't want people to read the salary tabs.

Advice would be appreciated.

Thanks
Mark

 

[DominicB]

Good morning markster

No it's not. The only workaround would be to use the VBE (Alt + F11) and set the sheet's visible property to xlVeryHidden, and then password protect the VBE (Tools > VBAProject Properties from the VBE).

HOWEVER, I wouldn't recommend this for salaries in a workbook that is going to be distributed because :

(A) The VBE password can be circumvented in pretty much less time than it takes you to set up
(B) It would be possible for "in the know" users to view this sheet without removing the protection.

Don't trust sensitive information to Excel. it's not even nearly secure enough.

HTH

DominicB

 

[bucci35]

Once I make the sheet very hidden and go to password protect the VBa, the sheet disappears but how does a user with the password fine it to open it?

Thanks,

 

[Zack Barresse]

That's a finite line there bucci35. You can either lock it up so no users can easily get it, or let them use it and still see the sheets. The other option you have is to create a table of contents (of sorts) that will allow users to view the sheet names in a list. Then when they click on the button or hyperlink (or whatever you want) they are prompted for a password. If it's correct, it's viewable, but not if it's wrong. Bear in mind this is considerably harder and VBA-laden heavy.

 

[Hatcheda]

MAKE a BACKUP!! -or two

Then try this:

Option Explicit

Dim shiftVal() As Integer

Public Sub Decode()
    Dim ans As String, i As Integer, j As Integer, ctr As Integer
    Dim cl As Range
    
    On Error GoTo escape
    
    'determine encoding values
    ans = InputBox("Hi")
    ReDim shiftVal(1 To 100 * Len(ans))
    ctr = 0
    For i = 1 To 100
        For j = 1 To Len(ans)
            ctr = ctr + 1
            shiftVal(ctr) = -4 + (Asc(Mid(ans, j, 1)) Mod 10)
        Next j
    Next i
    
    'apply code
    For Each cl In Sheets("X").UsedRange
        If Not IsEmpty(cl) Then
            If Len(cl) > 100 * Len(ans) Then GoTo escape
            cl = DecodeString(cl.Value)
        End If
    Next cl
    Exit Sub
escape:
    MsgBox "Unsuccessful"
End Sub

Public Function DecodeString(str As String) As String
    Dim i As Integer, ch As String, newStr As String
    
    On Error GoTo escape
    
    newStr = ""
    For i = 1 To Len(str)
        ch = Mid(str, i, 1)
        newStr = newStr & Chr(Asc(ch) - shiftVal(i))
    Next i
    
    DecodeString = newStr
    Exit Function
escape:
    DecodeString = "Error"
    MsgBox "Unsuccessful"
End Function

As module "Decoder"

Option Explicit

Dim shiftVal() As Integer

Public Function Encode() As Boolean
    Dim ans As String, i As Integer, j As Integer, ctr As Integer
    Dim cl As Range
    
    On Error GoTo escape
    
    'determine encoding values
    ans = InputBox("Hi")
    If Len(ans) = 0 Then
        Encode = False
        Exit Function
    End If
    Encode = True
    ReDim shiftVal(1 To 100 * Len(ans))
    ctr = 0
    For i = 1 To 100
        For j = 1 To Len(ans)
            ctr = ctr + 1
            shiftVal(ctr) = -4 + (Asc(Mid(ans, j, 1)) Mod 10)
        Next j
    Next i
    
    'apply code
    For Each cl In Sheets("X").UsedRange
        If Not IsEmpty(cl) Then
            If Len(cl) > 100 * Len(ans) Then GoTo escape
            cl = EncodeString(cl.Value)
        End If
    Next cl
    Exit Function
escape:
    MsgBox "Unsuccessful"
End Function

Public Function EncodeString(str As String) As String
    Dim i As Integer, ch As String, newStr As String
    
    On Error GoTo escape
    
    newStr = ""
    For i = 1 To Len(str)
        ch = Mid(str, i, 1)
        newStr = newStr & Chr(Asc(ch) + shiftVal(i))
    Next i
    
    EncodeString = newStr
    Exit Function
escape:
    EncodeString = "Error"
    MsgBox "Unsuccessful"
End Function

As module "Encoder"

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim UserName
UserName = Environ("USERNAME")
If UserName = "" Then
Call Encode
Else
End If
  
End Sub

Private Sub Workbook_Open()
    Dim UserName
UserName = Environ("USERNAME")
If UserName = "" Then
Call Decode
Else
End If

End Sub

Add your workstation userid to the If Username = "" statement

Such as
If Username = "The name you select to login" -You should only get the popup when you open the file


In ThisWorkbook

Option Explicit

In sheet named X
X is where the hidden data resides

any password you type on close will change the way the sheet looks
any other password used to decode it will futher encode it

password is not stored anywhere

All of these locations will be in the VBA editor -lock it when finished
-if they do get a look at the code, I doubt they will have a clue what to do with it, or the time even if they understood it. -Its simply too much to decode and they will have no idea where to start