Select multiple rows depending on value of A1 - vba

Question

I have a spreadsheet with employees and data listed. The drop-down in A1 lets someone select the employee and then it hides the rows for all other employees. I want to add the names of supervisors in the drop-down of A1 and have it select only the employees under that supervisor and hide the rest. The number of employees under each supervisor ranges from 3 to 6.
This is what I have to hide the rows when selecting a single employee :
The data is on worksheet1 and the list of employees and supervisors is on sheet2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, i, j As Long
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveWindow.FreezePanes = False
UsedRange.Rows.Hidden = False
If IsEmpty(Cells(1, 1)) Then Exit Sub
v = Cells(1, 1).Value
For i = 2 To 40 ' Show/Hide the Analysts rows - Add/Substract to the second number when adding/removing analysts
If Not Cells(i, 1) = v Then Rows(i).Hidden = True
If v = "Select Analysts/Supervisors" Then Rows(i).Hidden = False
Next i
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
Cells(2, 1).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Anyone got any ideas on how to do this? I'm using Excel 2010

Answer 1

I hope i did right understand your question and excel workbook stucture.
You have to create range on the data sheet (in this example its named range: 'rngSupervisors')
In this range you put your supervisors names (column headers)
under each supervisor you write the employees. Each row, 1 employee.
The supervisors itself must be in your employee list to select it, for drop down.
so the data worksheet has for eaxample:
B1: supervisor1
C1: supervisor2
D1: supervisor3
than the employees
B2: emplyee1_UnderSupervisor1
B2: emplyee2_UnderSupervisor1
B2: emplyee3_UnderSupervisor1
C2: emplyee1_UnderSupervisor2
C2: emplyee2_UnderSupervisor2
.
.
then you have to name this range "B1:D1" as "rngSupervisors"
In this example the data worksheet is the second one. I would advise you to use the named worksheet, or better direct reference it (give name of worksheet in VBA editor, than you can reference it directly).
Here i created the a function that tests if Argument1-string is the advisor of Argument2-string. Than you can use this function to test it, if it is false, and the name dont match, than you can hide the row.
I tried to make minimal modifications on your code (but it could be good improved.. or the method you make it all, could be probably realised with excel filters)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant, i, j As Long
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveWindow.FreezePanes = False
UsedRange.Rows.Hidden = False
If IsEmpty(Cells(1, 1)) Then Exit Sub
v = Cells(1, 1).Value
For i = 2 To 40 ' Show/Hide the Analysts rows - Add/Substract to the second number when adding/removing analysts
'if the name is not under selected supervisor, and its not selected name, hide the row
If Not isSupervisor(CStr(v), CStr(Cells(i, 1).Value)) And Not Cells(i, 1) = v Then
Rows(i).Hidden = True
End If
Next i
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
Cells(2, 1).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'returns true if sEmplName is under sSupName supervisor
Private Function isSupervisor(sSupName As String, sEmplName As String) As Boolean
Dim wksDataSheet As Worksheet 'worksheet where supervisor and employes data saved
Dim rngSupCell As Range 'range with supervisor names/headers
Dim lSupColumn As Long 'column of selected supervisor
Dim lSupLastRow As Long 'last row with employes names of column of supervisor
Dim lCurrentRow As Long 'counter for current row by iteration
Set wksDataSheet = ThisWorkbook.Sheets(2) 'or some named sheet for example ThisWorkbook.Sheets("DataSheet")
With wksDataSheet
'for each cell in supervisor names range
For Each rngSupCell In .Range("rngSupervisors") 'could be .Range("A3:A6") for example
'if supervisor name found in the range
If StrComp(rngSupCell.Value, sSupName, vbTextCompare) = 0 Then
'get column
lSupColumn = rngSupCell.Column
'get last row
lSupLastRow = .Cells(.Rows.Count, "A").End(xlUp).row
'for each employee name, starts from next row
For lCurrentRow = rngSupCell.row + 1 To lSupLastRow
'if equals, return true, exit.
If StrComp(.Cells(lCurrentRow, lSupColumn).Value, sEmplName, vbTextCompare) = 0 Then
isSupervisor = True
Exit Function
End If
Next lCurrentRow
End If
Next rngSupCell
End With
'nothing found, return false
isSupervisor = False
End Function