View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron Rosenfeld[_2_] Ron Rosenfeld[_2_] is offline
external usenet poster
 
Posts: 1,045
Default List of Direct and Indirect Reports

On Wed, 4 Jan 2012 12:41:39 -0800 (PST), John Menken wrote:

I have an Excel 2010 spreadsheet like the one shown in Fig 1 below. At
work I am continually asked for "group" reports which means that the
requestor wants to see everyone in so and so's group. For example, if
I get a request to see everyone in David Drew's group then the
finished report would look like Fig 2. below. A dream macro would be
one that prompts me for a Last name, lets me input a name, then
presto, places a report like Fig 2 on sheet2 of the workbook. Can
anyone help me with the code that might do something like this? Thanks
for entertaining my plight.


This needs considerable "prettying up" but should get you started. It's getting late so I did no more than the basics.
Given that you want to be prompted for a name, I decided to construct a list of the last names only, and have that pop up in a List Box (User Form)

I am assuming you have some familiarity with the VBE.

Some of the assumptions:
Your main data is on Sheet1
Your report will be on Sheet2
There is nothing else of value on Sheet2
There are no duplicate last names (with different first names) to be considered.
Column F on your main data sheet has an entry for every (or at least for the last) row.

Some areas to "pretty up"
Formatting
Have OK Cancel buttons on the User Form and the associated code to allow a more elegant exit other than just closing the form with the upper right "X" button.
Have some code to make sure that autofilter is NOT enabled on Sheet1 when you run the macro, else the macro will crash.

Here is your main code which should go into a "regular" module. That is produced by ensuring your project is highlighted in the VBE; then selecting Insert/Module from the main menu bar:

========================================
Public rTable1 As Range
Public sManager As String
Option Explicit
Sub GroupReport()
Dim rReport As Range
Dim colCriteria As Collection
Dim Criteria As String, aCriteria() As String
Dim c As Range
Dim i As Long
Dim sFirstAddress As String

'assumes column F filled all the way down
With Worksheets("Sheet1")
Set rTable1 = .Range("A1", .Cells(.Rows.Count, "F").End(xlUp))
End With
Set rReport = Worksheets("Sheet2").Cells(1, 1)
Set colCriteria = New Collection

UserForm1.Show
'Selected Manager now in sManager

Criteria = rTable1.Columns(2).Find(what:=sManager, LookIn:=xlValues, _
lookat:=xlWhole).Offset(columnoffset:=1).Text

colCriteria.Add Item:=Criteria, Key:=Criteria

With rTable1.Columns(4)
Do
For i = 1 To colCriteria.Count
Set c = .Find(what:=colCriteria(i))
If Not c Is Nothing Then
sFirstAddress = c.Address
Do
'use Collection to prevent duplicates
On Error Resume Next
colCriteria.Add Item:=c.Offset(columnoffset:=-1).Text, _
Key:=c.Offset(columnoffset:=-1)
On Error GoTo 0
Set c = .FindNext(c)
Loop While Not c Is Nothing And sFirstAddress < c.Address
End If
Next i
Loop Until i colCriteria.Count
End With

ReDim aCriteria(1 To colCriteria.Count)
For i = 1 To colCriteria.Count
aCriteria(i) = colCriteria(i)
Next i

rTable1.AutoFilter field:=4, Criteria1:=aCriteria, _
Operator:=xlFilterValues

rReport.Worksheet.Cells.Clear
rTable1.SpecialCells(xlCellTypeVisible).Copy Destination:=rReport
rReport.Worksheet.Cells.EntireColumn.AutoFit

rTable1.AutoFilter
End Sub
=========================================

For the User Form, select Insert/User Form. A design window will open on which you will draw a User Form; and then draw a ListBox inside the user form.
The UserForm has a name of "UserForm1"
The ListBox is named "ManagerNames"

The code behind the UserForm (which you get to by right-clicking on the userform design and selecting View Code) is as below:

============================
Option Explicit
Private Sub ManagerNames_Click()
sManager = ManagerNames.Text
End Sub

Private Sub userform_initialize()
Dim ManagerList()
Dim i As Long
ManagerList = WorksheetFunction.Transpose(rTable1.Resize( _
rowsize:=rTable1.Rows.Count - 1, columnsize:=1). _
Offset(rowoffset:=1, columnoffset:=1))

For i = LBound(ManagerList) To UBound(ManagerList)
ManagerNames.AddItem ManagerList(i)
Next i

End Sub
==============================

If you've done all this correctly, when you execute the macro, the form should pop up with a box of last names of which you can select only one. Select that name and exit the box by clicking the "X" in the upper right corner. The macro then determines the filtering to use for the autofilter in order to produce your desired report. It will then clear Sheet2, write the report to sheet2, and adjust the column widths.

Finally it will turn off the autofilter for the data. This is important since if the macro starts with the autofilter enabled, it will crash.