MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Excel Pivot Table Drop Down Macro

  Asked By: Harry    Date: Sep 12    Category: MS Office    Views: 3891

I am a very new to macro creation though I used to do the /x macros
in Lotus a lifetime ago.

I need help in creating a macro for users of information / data I
provide in a pivot table twice a week.

I am running a process which downloads information for ~500 people.
This information is then placed into a pivot table and distributed
to a number of managers. Each manager has 10 to 20 people working
for him/her. Currently, a manager must manually select the
individuals from the Names drop down to examine their information.
Is there a macro (which I can provide the managers) which will take
a list of Names, and go to the filed of Names in the pivot table and
select only those names from the drop down list?

Right now, the table is going against ~50,000 records of which I
need to make sophisticated calculations on before loading into a
pivot table. When it grows to 65k - it will be loaded into access
in discrete chunks.



1 Answer Found

Answer #1    Answered By: Audris Schmidt     Answered On: Sep 12

The macro  & function below should meet your needs. Copy & paste the code below
into a code module in a new workbook. Send this workbook to each of your
managers with instructions to enter his/her employees on Sheet1 in column A
starting in row 1.

To run the macro:
1. Have the macro workbook open.
2. Open the pivot  table workbook. Click any cell in the table.
3. select  Macro >> Macros from the Tools menu, or press {Alt}{F8}, to display
list  of all available macros. Run the macro SelectNames.

Option Base 1

Public Sub SelectNames()
'Select names  from a list for display in a pivot table.
Dim Namez() As String, NameCnt As Long
Dim msg1 As String, x As Long, y As Long, FoundIt As Boolean
Dim StartWB As Workbook, StartSht As Worksheet, StartCell As Range
On Error GoTo SNerr1
Set StartWB = ActiveWorkbook
Set StartCell = ActiveCell
Set StartSht = ActiveSheet
'If the active cell is not in a pivot table, tell user & quit.
If IsPivotTable(ActiveCell) = False Then
MsgBox "You must select a cell in the pivot table  before running  the
macro", _
vbExclamation, "SelectNames error"
GoTo Cleanup1
End If
Application.ScreenUpdating = False
'Read the list of names from Sheet1 in this workbook.
NameCnt& = 0
Do While Len(ActiveCell.Value) > 0
NameCnt& = NameCnt& + 1
ReDim Preserve Namez(NameCnt&)
Namez(NameCnt&) = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
'Return to the starting workbook/sheet/cell.
'Cycle through all pivotitems in the Name fields for this pivot table. Check
each one against Namez().
'If in Namez(), set visible to TRUE; if not, set to FALSE.
With ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
For x& = 1 To .PivotFields("Name").PivotItems.Count
FoundIt = False
For y& = 1 To NameCnt&
If .PivotFields("Name").PivotItems(x&).Value = Namez(y&) Then
FoundIt = True
Exit For
End If
Next y&
If FoundIt = True Then
.PivotFields("Name").PivotItems(x&).Visible = True
.PivotFields("Name").PivotItems(x&).Visible = False
End If
Next x&
End With
Set StartWB = Nothing
Set StartSht = Nothing
Set StartCell = Nothing
Application.ScreenUpdating = True
Exit Sub
If Err.Number <> 0 Then
msg1$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg1$, , "SelectNames error", Err.HelpFile, Err.HelpContext
End If
GoTo Cleanup1
End Sub

Private Function IsPivotTable(InCell As Range) As Boolean
On Error GoTo IPTerr1
'Try to select the RowRange of the pivot table which contains InCell. If
'reactivate InCell and return TRUE.
IsPivotTable = True
Exit Function
'If can't select the RowRange, return FALSE (not a pivot table).
IsPivotTable = False
End Function

Didn't find what you were looking for? Find more on Excel Pivot Table Drop Down Macro Or get search suggestion and latest updates.