Lists

HRDataFool · Sep 24, 2004

I am preparing a multi-departmental spreadsheet and would like to have it set up so that the manager can key in their dpeartment id and then have only their employees populate. Some of the information is confidential and managers should only be able to see who reports to them. How can I do this?

shades · Sep 24, 2004

I setup a file whereby the manager/vp would log on with a username, the vba would check a list to make sure the person was on the list. Then if "passed" they entered a password, which was checked against another list, and if approved, then only their workers would show up in a resultant table.

Is this what you are looking for?

HRDataFool · Sep 24, 2004

Yes...this is exaclty what I would like to do, but I am clueless at this.

shades · Sep 24, 2004

I sent you an email (with attachment) to make sure this is the direction you want to go. If this is going to work, I will post more here as well to explain.

shades · Sep 24, 2004

For this demo there are three pages: Login, ShowData and Admin. Only the Login worksheet is visible. After logging in correctly, the Login worksheet hides, and the ShowData worksheet is visible. On ShowData, the user clicks on a cell to view data only applicable to his/her team.

Here is the Admin page setup for doing this:

DoubleEntryDisplayVBAposted.xls

A

B

C

D

E

F

G

H

1

LastName

Password

2

AAAA

1111

3

ABCD

1234

LastName

Password

4

BBBB

2222

User

Peter

Simon

ThesecomefromInputBoxes

5

Johnson

Jake

Check

Peter

Simon

6

Peter

Simon

7

Ref

Name

Topic

8

1

ABCD

9

2

ABCD

ABCDSt

10

3

ABCD

ABCDBox

11

4

ABCD

ABCDTop

12

5

Johnson

13

6

Johnson

JohnsonSt

14

7

Johnson

JohnsonBox

15

8

Johnson

JohnsonTop

16

9

AAAA

17

10

AAAA

AAAATop

18

11

AAAA

AAAABottom

19

12

BBBB

20

13

BBBB

BBBBTop

21

14

Peter

Peter1

22

15

Peter

Peter2

23

16

Peter

Peter3

24

17

Peter

Peter4

25

18

Peter

Peter5

Admin

-----------------

The formula in F5 is:

INDEX(PWList,MATCH($H$4,LName,),MATCH($H$3,$A$1:$B$1,))

G5:

INDEX(PWList,MATCH($H$4,LName,),MATCH($I$3,$A$1:$B$1,))

Named ranges:

PWList: =OFFSET(Admin!$A$1,0,0,COUNTA(Admin!$A:$A),2)
LName: =Admin!$A$1:$A$6

For each name in Column A, there is an associated named range in E, to be used in the formulas and in the VBA code.

shades · Sep 24, 2004

Here is the code for the sheets in the general modules

Code:

Sub UserPassword()
    Dim LastName As String, PassWord As String, myName As String
Application.ScreenUpdating = False
    ActiveWorkbook.Sheets("Admin").Visible = True
    ActiveWorkbook.Sheets("Admin").Activate
    myName = InputBox("Enter Last Name")
    If myName = "" Then
        ActiveWorkbook.Sheets("Admin").Visible = False
        Exit Sub
    Else
    End If

    Sheets("Admin").Range("H4").Value = myName
    
'MsgBox Application.WorksheetFunction.VLookup(Sheets("Passwords").Range("H4").Value, Range("A2:A6"), 1, True)
    If Application.WorksheetFunction.VLookup(Sheets("Admin").Range("H4").Value, Range("A2:A6"), 1, True) = Sheets("Admin").Range("H4").Value Then
        Sheets("Admin").Range("I4").Value = InputBox("Enter Password")
        If Sheets("Admin").Range("I5").Value = Sheets("Admin").Range("I4").Value Then
            Sheets("ShowData").Range("B2").Value = Sheets("Admin").Range("H4").Value
            ActiveWorkbook.Sheets("ShowData").Visible = True
            ActiveWorkbook.Sheets("Intro").Visible = False
            ActiveWorkbook.Sheets("Admin").Visible = False
            ActiveWorkbook.Sheets("ShowData").Select
        Else:
            ActiveWorkbook.Sheets("Admin").Visible = False
            MsgBox ("You have entered wrong Password")
        End If
    Else
        ActiveWorkbook.Sheets("Admin").Visible = False
        MsgBox ("Your Name is not listed")
    End If
Application.ScreenUpdating = True
End Sub

Code:

Sub ValidationTest()
    Dim myName As String
    Dim ABCDList As Range
    Dim JohnsonList As Range
    Dim AAAAList As Range
    Dim BBBBList As Range
    Dim PeterList As Range
    
    With Range("B3")
        .Font.Bold = True
        .Font.Size = 12
        .Font.Color = vbRed
        .Interior.Color = vbYellow
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    myName = Sheets("ShowData").Range("B2").Value
    Select Case myName
        Case "ABCD"
            Sheets("ShowData").Range("B3").Select
            With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=ABCDList"
                .IgnoreBlank = True
                .InCellDropdown = True
            End With
        Case "Johnson"
            Sheets("ShowData").Range("B3").Select
            With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=JohnsonList"
                .IgnoreBlank = True
                .InCellDropdown = True
            End With
        Case "Peter"
            Sheets("ShowData").Range("B3").Select
            With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=PeterList"
                .IgnoreBlank = True
                .InCellDropdown = True
            End With
        Case "AAAA"
            Sheets("ShowData").Range("B3").Select
            With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=AAAAList"
                .IgnoreBlank = True
                .InCellDropdown = True
            End With
        Case "BBBB"
            Sheets("ShowData").Range("B3").Select
            With Selection.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=BBBBList"
                .IgnoreBlank = True
                .InCellDropdown = True
            End With
    End Select
End Sub

Code:

Sub EndSession()
    Application.ScreenUpdating = False
    ActiveWorkbook.Sheets("Intro").Visible = True
    ActiveWorkbook.Sheets("ShowData").Range("B2").ClearContents
    ActiveWorkbook.Sheets("ShowData").Range("B3").Clear
    ActiveWorkbook.Sheets("ShowData").Range("B3").Validation.Delete

    ActiveWorkbook.Sheets("ShowData").Visible = False
    Application.ScreenUpdating = True
End Sub

This following code goes into the Workbook module:

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Sheets("ShowData").Visible = False
    ActiveWorkbook.Close True
End Sub

shades · Sep 27, 2004

Just to let you know, I emailed you revisions so that it will accommodate expansion in names of managers, people under each manager, and a database to pull data from. I also changed from Data Validation to filling all the cells.

I managed to change this to make it more flexible. I added another worksheet, named "Base" that will house your main data.

1. Names and Passwords will continue on Admin sheet in columns A and B. I defined a dynamic range to accommodate additions without changing names:

LName =OFFSET(Admin!$A$1,0,0,COUNTA(Admin!$A:$A),1)
PWList =OFFSET(Admin!$A$1,0,0,COUNTA(Admin!$A:$A),2)

2. Each name then is presented in a separate column with people underneath each, also using dynamic names to accommodate more people:

AAAAList =OFFSET(Admin!$H$2,0,0,COUNTA(Admin!$H:$H)-1,1)
ABCDList =OFFSET(Admin!$I$2,0,0,COUNTA(Admin!$I:$I)-1,1)
BBBBList =OFFSET(Admin!$J$2,0,0,COUNTA(Admin!$J:$J)-1,1)
JohnsonList =OFFSET(Admin!$K$2,0,0,COUNTA(Admin!$K:$K)-1,1)
PeterList =OFFSET(Admin!$L$2,0,0,COUNTA(Admin!$L:$L)-1,1)

3. If you add a new manager, then add it in column A Ralph), and after the last used column (i.e. after PeterList). Then add one new dynamic range, using these formulas (i.e. RalphList =OFFSET(Admin!$M$2,0,0,COUNTA(Admin!$M:$M)-1,1)

4. I changed the macros so that it will put the names in Column B, starting with B4, and fill down as appropriate (no longer Data Validation dropdown in B3). Then I added some column headings in row 3 (i.e. Category 1, Category2...). These refer to the columns in the new worksheet "Base"; the full data is named dynamically

myDataBase =OFFSET(Base!$A$1,0,0,COUNTA(Base!$A:$A),COUNTA(Base!$1:$1))

Thus, you can add columns as needed and will always be in the data. be sure to include new columns on the ShowData worksheet

That will be the basis for pulling data into the ShowData worksheet. You can set up formulas and then have the macro place them each time you run the program. Right now the "end" macro clears all cells in the dynamic named range,

DataList =OFFSET(ShowData!$B$4,0,0,COUNTA(ShowData!$B:$B)-2,COUNTA(ShowData!$3:$3))

That way, it will always be cleared. Another approach might be to hide those columns with formulas always present, and then use a macro to hide the columns, until the next login, and then have the login macro also unhide the columns.

At least you should have a workable solution.

HTH

shades · Sep 27, 2004

Here is the modified code to handle the changes in the worksheets:

Code:

Sub UserPassword()
    Dim LastName As String, PassWord As String, myName As String
Application.ScreenUpdating = False
    ActiveWorkbook.Sheets("Admin").Visible = True
    ActiveWorkbook.Sheets("Admin").Activate
    myName = InputBox("Enter Last Name")
    If myName = "" Then
        ActiveWorkbook.Sheets("Admin").Visible = False
        Exit Sub
    Else
    End If

    Sheets("Admin").Range("D2").Value = myName
    
'MsgBox Application.WorksheetFunction.VLookup(Sheets("Passwords").Range("D2").Value, Range("A2:A6"), 1, True)
    If Application.WorksheetFunction.VLookup(Sheets("Admin").Range("D2").Value, Range("A2:A6"), 1, True) = Sheets("Admin").Range("D2").Value Then
        Sheets("Admin").Range("E2").Value = InputBox("Enter Password")
        If Sheets("Admin").Range("E3").Value = Sheets("Admin").Range("E2").Value Then
            Sheets("ShowData").Range("B2").Value = Sheets("Admin").Range("D2").Value
            ActiveWorkbook.Sheets("ShowData").Visible = True
            ActiveWorkbook.Sheets("Intro").Visible = False
            ActiveWorkbook.Sheets("Admin").Visible = False
            ActiveWorkbook.Sheets("ShowData").Select
        Else:
            ActiveWorkbook.Sheets("Admin").Visible = False
            MsgBox ("You have entered wrong Password")
        End If
    Else
        ActiveWorkbook.Sheets("Admin").Visible = False
        MsgBox ("Your Name is not listed")
    End If
'   This calls the next macro for filling in the data
    ViewData
Application.ScreenUpdating = True
End Sub


Sub ViewData()
    Dim myName As String
    Dim ABCDList As Range
    Dim JohnsonList As Range
    Dim AAAAList As Range
    Dim BBBBList As Range
    Dim PeterList As Range
    
    myName = Sheets("ShowData").Range("B2").Value
    Select Case myName
        Case "AAAA"
            Sheets("Admin").Range("AAAAList").Copy Sheets("ShowData").Range("B4")
        Case "ABCD"
            Sheets("Admin").Range("ABCDList").Copy Sheets("ShowData").Range("B4")
        Case "BBBB"
            Sheets("Admin").Range("BBBBList").Copy Sheets("ShowData").Range("B4")
        Case "Johnson"
            Sheets("Admin").Range("JohnsonList").Copy Sheets("ShowData").Range("B4")
        Case "Peter"
            Sheets("Admin").Range("PeterList").Copy Sheets("ShowData").Range("B4")
    End Select

End Sub

Sub EndSession()
    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveWorkbook.Sheets("Intro").Visible = True
    ActiveWorkbook.Sheets("ShowData").Range("B2").ClearContents

    Sheets("ShowData").Range("DataList").ClearContents
    ActiveWorkbook.Sheets("ShowData").Visible = False
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Lists

HRDataFool

New Member

Excel Facts

shades

Well-known Member

HRDataFool

New Member

shades

Well-known Member

shades

Well-known Member

shades

Well-known Member

shades

Well-known Member

shades

Well-known Member

Similar threads

Forum statistics

Share this page

Lists

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock