Extracting Various Data from a list with Same Criteria

[tsroque]

I have a group of employees with their group number in an Excel worksheet. I need to individually group these employees under their Manager's ID in worksheet2.

Book2
	A	B	C	D	E	F	G	H	I
1	Jan			Feb			Mar
2	Name	GroupID	MgrID	Name	GroupID	MgrID	Name	GroupID	MgrID
3	Employee1	Group1	Mgr1	Employee1	Group1	Mgr1	Employee1	Group1	Mgr1
4	Employee2	Group1	Mgr1	Employee2	Group1	Mgr1	Employee2	Group1	Mgr1
5	Employee3	Group3	Mgr3	Employee3	Group3	Mgr3	Employee3	Group3	Mgr3
6	Employee4	Group1	Mgr1	Employee4	Group1	Mgr1	Employee4	Group1	Mgr1
7	Employee5	Group2	Mgr2	Employee5	Group2	Mgr2	Employee5	Group2	Mgr2
8	Employee6	Group3	Mgr3	Employee6	Group3	Mgr3	Employee6	Group3	Mgr3
9	Employee7	Group3	Mgr3	Employee7	Group3	Mgr3	Employee7	Group3	Mgr3
10	Employee8	Group2	Mgr2	Employee8	Group2	Mgr2	Employee8	Group2	Mgr2
11	Employee9	Group3	Mgr3	Employee9	Group3	Mgr3	Employee9	Group3	Mgr3
12	Employee10	Group1	Mgr1	Employee10	Group1	Mgr1	Employee10	Group1	Mgr1
13	Employee11	Group2	Mgr2	Employee11	Group2	Mgr2	Employee11	Group2	Mgr2
14	Employee12	Group3	Mgr3	Employee12	Group3	Mgr3	Employee12	Group3	Mgr3
15	Employee13	Group1	Mgr1	Employee13	Group1	Mgr1	Employee13	Group1	Mgr1
16	Employee14	Group2	Mgr2				Employee14	Group2	Mgr2
17	Employee15	Group2	Mgr2				Employee15	Group2	Mgr2
18							Employee16	Group3	Mgr3
Sheet1

On Worksheet2, I set up a Validation list. When I choose a month, I want that corresponding information to filter on Worksheet2 and list the Employees with the same Mgr's ID.

Book2
	A	B	C	D	E	F
1	Month	Mar
2	Mgr1		Mgr2		Mgr3
3	Name	GroupID	Name	GroupID	Name	GroupID
4	Employee01	Group1	Employee05	Group2	Employee03	Group3
5	Employee02	Group1	Employee08	Group2	Employee06	Group3
6	Employee04	Group1	Employee11	Group2	Employee07	Group3
7	Employee10	Group1	Employee14	Group2	Employee09	Group3
8	Employee13	Group1	Employee15	Group2	Employee12	Group3
9					Employee16	Group3
10
11
12
13
14
15
Sheet2

Yes...I know I could Auto Filter it, and then copy and paste it to a separate worksheet, but what's the fun in that if you can automate it! Keep in mind that new Mgrs could be added.

Thanks!
:D

 

[Legacy 68668]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, i As Long, b(), t As Long, x, w(), maxRow As Long
If Target.Address(0,0) <> "A1" Then Exit Sub
If IsError(Application.Match(Target.Value, Sheets("sheet1").Rows(1), 0)) Then
    MsgBox "data not found"
    Exit Sub
End If
Application.EnableEvents = False
Rows("2:" & Rows.Count).Clear
With Sheets("sheet2")
    a = .Range(.Cells(1, x), .Cells(Rows.Count, x).End(xlUp)).Resize(, 3).Value
End With
ReDim b(1 To UBound(a, 1), 1 To Columns.Count)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 3 To UBound(a, 1)
        If Not .exists(a(i, 3)) Then
            t = t + 2
            .add a(i, 3), VBA.Array(2, t)
            b(1, t - 1) = a(i, 3) : b(2, t - 1) = "Name"
            b(2, t) = "Group ID"
        End If
        w = .item(a(i, 3)): w(0) = w(0) + 1
        b(w(0), w(1) - 1) = a(i, 1) : b(w(0), w(1)) = a(i, 2)
        .item(a(i, 3)) = w
        maxRow = Application.Max(maxRow, w(0))
    Next
End With
If .count > 0 Then
    With Range("a2").Resize(maxRow, t)
        .Value = b
        .Rows(1).Interior.ColorIndex = 16
        .Rows(2).Interior.ColorIndex = 15
    End With
End If
End Sub

 

[mikerickson]

AdvancedFilter's copy to other range will work.
However, the destination sheet must be active when AdvancedFilter is pressed, otherwise you get a misleading error message.

 

[tsroque]

Hi Seiya -

It gets stuck at:

If .count > 0 Then
With Range("a2").Resize(maxRow, t)
.Value = b
.Rows(1).Interior.ColorIndex = 16
.Rows(2).Interior.ColorIndex = 15
End With
End If
End Sub

And I'm assuming that when I change the validation selection in A2, it runs the formula?

Thanks Mike for your suggestion... I'll experiment with the AdvancedFilter tool as well, but it's still not quite automating my work...I'm lazy...

 

[Legacy 68668]

Can you change to

If t > 0 Then