Read the count of filters in ms project and populate in Excel

user_19722519 0
Viewed 46

I want to create a table in excel which show the count of rows when a filter is applied in ms project. The table should have the filter names as column headers and count of the rows filtered in each column under the header like this

filter 1 filter 2 filter 3 0 10 3

I can write basic macros in excel and ms project.

I use the below to count rows. applyfilter = fitler1 select all countFitleredRows = ActiveSelection.Tasks.Count

But how do I read the countFitleredRows for mulitple fitlers and create a table in excel. If some one has a working macro that would be great. otherwise I want to know the logic of writing the values in the form of a table in excel.

regards, Waqas.

ms-project vba excel
2 Answers

Waqas Mahmood, Although I don't have a macro that does exactly what you want, the following macro will provide a basic structure for creating what you want. John

Sub BaseCalendarExceptions()
'This macro exports the exceptions for all base calendars in a given     Project file
'(modified version of the CalendarExceptions macro published previously in this forum)
' Written by John - Project 2/8/16
Dim MyXL As Object
Set MyXL = CreateObject("Excel.Application")
Dim i As Integer, j As Integer
Dim BC As Calendar
Dim E As Exception
Dim xlRng As Range

'open Excel, define workbook, and set column headers
MyXL.Workbooks.Add
MyXL.Visible = True
MyXL.ActiveWorkbook.Worksheets.Add.Name = "BaseCal Exc Report"
MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Activate
Set xlRng = MyXL.ActiveSheet.Range("A1")
xlRng.Range("A1") = "Proj Cal Holidays"
xlRng.Range("B1") = "Base Calendar"
xlRng.Range("C1") = "Start Date"
xlRng.Range("D1") = "Finish Date"

'Gather and export Project calendar exceptions
j = 0
For Each BC In ActiveProject.BaseCalendars
    i = 2 + j
    If BC.Exceptions.Count > 0 Then
        For Each E In BC.Exceptions
            xlRng.Range("A" & i) = E.Name
            xlRng.Range("B" & i) = BC.Name
            xlRng.Range("C" & i) = E.Start
            xlRng.Range("D" & i) = E.Finish
            i = i + 1
        Next E
    End If
    j = i
Next BC
MyXL.ActiveWorkbook.Worksheets("BaseCal Exc Report").Columns("A:D").AutoFit

End Sub
user_196341230

The routine creates an Excel file and loops through all the task filters, creating a column for each filter with the name (row 1) and # tasks (row 2).

Sub FilteredTaskCountReport()

    Dim appXl As Object
    Set appXl = CreateObject("Excel.Application")
    appXl.Visible = True
    
    Dim wbk As Object
    Set wbk = appXl.Workbooks.Add
    Dim wst As Object
    Set wst = wbk.Worksheets(1)
    
    Dim CurrentTaskUID As Long
    CurrentTaskUID = ActiveCell.Task.UniqueID
    OutlineShowAllTasks
    
    Dim f As Variant
    Dim c As Integer
    c = 0
    For Each f In ActiveProject.TaskFilterList
        FilterApply f
        SelectAll
        c = c + 1
        wst.Cells(1, c) = f
        On Error Resume Next
        wst.Cells(2, c) = ActiveSelection.Tasks.Count
        If Err.Number <> 0 Then
            wst.Cells(2, c) = 0
        End If
        On Error GoTo 0
    Next f
    
    FilterApply "&All Tasks"
    Find "Unique ID", "equals", CurrentTaskUID
    
    Set appXl = Nothing
    
End Sub
user_10566320
Related