Report to Show Work During Current Week Only

Question

I need to create a work-ahead dashboard for my team, for weekly planning meetings.

We have tasks that span several weeks, so a task may be needing work in the current week but not starting or ending in the current week.

Ideally, I'd like a report per resource that lists what's on their plate for that week. It would also be nice if the report included status metrics such as % work to be completed, if the task is behind, etc.

My project is setup such that the tasks are Fixed Work with hours per task. All the tasks have assigned resources at a certain %, and the resources are backed by calendars, etc. I don't have any cost information built in, however.

Any insight is appreciated. Thanks!

Late question, but I'm curious about "...for my team" and "I'd like a report..." conflict. Backing up a step, if the goal of the dashboard is to help them spot multi-week concerns and adjust their planning accordingly, shouldn't they be driving the format/iterations on it that will work best for that purpose? Or maybe I'm reading too much into it, and "I'd like a..." is actually "we'd like a..."? — Jeff Lindsey, Apr 6, 2016 at 19:44

Hey Romey · Accepted Answer · 2016-03-06 21:42:50Z

You could also create a custom filter with these parameters:

        Status      does not equal                  Complete
And     Active      equals                          Yes
And     Finish      is less than or equal to        "Start or Finish by:"?

The question mark in the last parameter is for user prompting, which will bring up a calendar to choose from.

Another option is to use the Resource Usage view. You can see how many hours each person is working on each task for the hour/day/week/etc.

Hey Romey · Accepted Answer · 2016-02-19 14:21:09Z

Try using this macro.


Public Sub ExcelSchedule()
'Creates a new table within the Task Sheet view (so it'll use the Task Sheet formatting), copies all data and pastes it into an Excel sheet.
'Within Excel, a table is created with slicers.

    Dim i As Integer

'Sniff Test
    'Is the Excel Library enabled?
    For i = 1 To ActiveProject.VBProject.references.Count
        If ActiveProject.VBProject.references.Item(i).Name = "Excel" Then
            GoTo LibraryFound 'found library, continue
        End If
    Next i

    'The Excel library was not found
    MsgBox "This macro requires the Excel Library to run." & vbNewLine & _
            "Take a screenshot of these instructions and click OK." & vbNewLine & vbNewLine & _
            "In MS Project, press ""Alt + F11"" to open the VBA Editor." & vbNewLine & _
            "Go to Tools >> References." & vbNewLine & _
            "Place a checkmark next to ""Microsoft Excel 15.0 Object Library"". Notice it is Excel and not Office." & vbNewLine & _
            "Click OK and run the macro again." _
                , vbCritical, "Oops! Missing Library"
End

LibraryFound:     'continue with macro
ExcelSchedule_exe
End Sub

Private Sub ExcelSchedule_exe()
'Variables
    Dim projectName As String
    Dim xlRange As Excel.Range
    Dim instrNotes As String

'Prepare
    On Error GoTo ErrorHandler
    UpdatesOFF
    SaveOriginalSettings
    WindowActivate TopPane:=True
    ViewApply Name:="Task Sheet"
    GroupApply Name:="No Group"
    FilterApply Name:="All Tasks"
    OutlineShowAllTasks

'Create Table in the Task Sheet View
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, Create:=True, OverwriteExisting:=True, FieldName:="ID", Title:="", Width:=6, Align:=1, ShowInMenu:=False, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, HeaderTextWrap:=False, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="ID", Title:="", Width:=7, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Predecessors", Title:="", Width:=7, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Successors", Title:="", Width:=7, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="% Complete", Title:="", Width:=7, Align:=2, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, HeaderTextWrap:=False, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Name", Title:="", Width:=50, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=True
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Resource Names", Title:="", Width:=18, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Status", Title:="", Width:=14, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, HeaderTextWrap:=False, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Work", Title:="", Width:=13, Align:=2, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Duration", Title:="", Width:=10, Align:=2, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Remaining Work", Title:="", Width:=15, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Start", Title:="", Width:=15, Align:=2, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Finish", Title:="", Width:=15, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Deadline", Title:="", Width:=14, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Baseline Start", Title:="", Width:=16, Align:=2, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Baseline Finish", Title:="", Width:=16, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Actual Start", Title:="", Width:=14, Align:=2, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Actual Finish", Title:="", Width:=14, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Start Variance", Title:="", Width:=14, Align:=2, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Finish Variance", Title:="", Width:=14, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Outline Level", Title:="", Width:=14, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Summary", Title:="", Width:=11, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, HeaderTextWrap:=False, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Active", Title:="", Width:=11, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Milestone", Title:="", Width:=11, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Critical", Title:="", Width:=10, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Number10", Title:="", Width:=13, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Text10", Title:="", Width:=13, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False
    TableEditEx Name:="Excel Report - Good + Fast", TaskTable:=True, NewFieldName:="Notes", Title:="", Width:=32, Align:=0, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, AlignTitle:=0, WrapText:=False, ShowAddNewColumn:=True
    TableApply Name:="Excel Report - Good + Fast"

'Create Remaining Work column without any letters
    CustomFieldSetFormula FieldID:=pjCustomTaskNumber10, Formula:="[Remaining Work]/60"
    CustomFieldRename FieldID:=pjCustomTaskNumber10, NewName:="Remaining Work Hrs"
    CustomFieldPropertiesEx FieldID:=pjCustomTaskNumber10, Attribute:=pjFieldAttributeFormula, SummaryCalc:=pjCalcNone, GraphicalIndicators:=False, AutomaticallyRolldownToAssn:=False

'Create Start column in m/d/yy format
    CustomFieldSetFormula FieldID:=pjCustomTaskText10, Formula:="format([Start],""m/dd/yyyy"")"
    CustomFieldRename FieldID:=pjCustomTaskText10, NewName:="Start Formatted"
    CustomFieldPropertiesEx FieldID:=pjCustomTaskText10, Attribute:=pjFieldAttributeFormula, SummaryCalc:=pjCalcNone, GraphicalIndicators:=False, AutomaticallyRolldownToAssn:=False


'Copy Project Tasks
    SelectSheet
    EditCopy

'--- EXCEL ---
    On Error Resume Next 'ignore errors from Excel
'Schedule Sheet
    'Prepare Excel File
        Set xlApp = New Excel.Application
        Set xlBook = xlApp.Workbooks.Add

        xlBook.Sheets.Add

        Set xlSheet = xlBook.Worksheets(1)
        Set xlSheet2 = xlBook.Worksheets(2)

        xlSheet2.Name = "Sheet3"
        xlApp.Visible = False

    'Paste Project Tasks into Excel
        xlSheet.Range("b1").Select
        xlSheet.Paste
        Set xlRange = xlSheet.UsedRange

        xlRange.WrapText = False
        xlSheet.ListObjects.Add(xlSrcRange, xlRange, , xlYes).Name = "Table1"

    'Insert icons
        'Insert column with formula
        xlSheet.Columns("h:h").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        xlSheet.Range("Table1[[#Headers],[Column1]]").Value = " "
        xlSheet.Range("h2").Value = _
            "=IF([@Active]=""No"",1" & _
                ",IF([@Status]=""Complete"",2" & _
                ",IF([@Status]=""Late"",3" & _
                ",IF(OR([@Status]=""Future Task"",[@Status]=""On Schedule""),4" & _
                "))))"

        'Configure conditional formatting
        xlSheet.Range("Table1[[ ]]").Select
        xlApp.Selection.FormatConditions.AddIconSetCondition
        xlApp.Selection.FormatConditions(xlApp.Selection.FormatConditions.Count).SetFirstPriority
        With xlApp.Selection.FormatConditions(1)
            .ReverseOrder = False
            .ShowIconOnly = True
            .IconSet = xlBook.IconSets(xl4TrafficLights)
        End With

        xlApp.Selection.FormatConditions(1).IconCriteria(1).Icon = xlIconGrayCircle
        With xlApp.Selection.FormatConditions(1).IconCriteria(2)
            .Type = xlConditionValueNumber
            .Value = 2
            .Operator = 7
            .Icon = xlIconGreenCheck
        End With
        With xlApp.Selection.FormatConditions(1).IconCriteria(3)
            .Type = xlConditionValueNumber
            .Value = 3
            .Operator = 7
            .Icon = xlIconRedFlag
        End With
        With xlApp.Selection.FormatConditions(1).IconCriteria(4)
            .Type = xlConditionValueNumber
            .Value = 4
            .Operator = 7
            .Icon = xlIconGreenCircle
        End With

    'Format Sheet
        xlApp.ActiveWindow.DisplayGridlines = False
        xlSheet.Columns("H:AA").EntireColumn.AutoFit
        xlSheet.Columns("F:F").ColumnWidth = 55
        xlSheet.Columns("F:F").WrapText = True
        xlSheet.Columns("A:A").ColumnWidth = 27.22

        xlSheet.Range("A1").Value = "Filters"
        xlSheet.Range("B2").Select
        xlApp.ActiveWindow.FreezePanes = True

    'insert column for ID - Name
        xlSheet.Columns("AC:AC").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        xlSheet.Range("Table1[[#Headers],[Column1]]").Value = "ID - Name"
        xlSheet.Range("AC2").Value = "=TRIM(CONCATENATE([@ID],"" - "",[@Name],"" | "",TEXT([% Complete],""0%""),"" Complete | Planned Finish: "",[@Finish]))"

        xlSheet.Columns("AA:AC").Hidden = True

        With xlSheet.Range("A1")
            .HorizontalAlignment = xlCenter
            .Range("A1").Style = "Accent5"
            .Font.Bold = True
        End With

    'Insert Slicers
        xlBook.SlicerCaches.Add2(xlSheet.ListObjects("Table1"), "Summary"). _
            Slicers.Add xlSheet, , "Summary", "Summary", _
            15, 1, 75, 50
        xlBook.SlicerCaches.Add2(xlSheet.ListObjects("Table1"), "Active"). _
            Slicers.Add xlSheet, , "Active", "Active", _
            15, 76, 75, 50
        xlBook.SlicerCaches.Add2(xlSheet.ListObjects("Table1"), "Milestone" _
            ).Slicers.Add xlSheet, , "Milestone", "Milestone", _
            65, 1, 75, 50
        xlBook.SlicerCaches.Add2(xlSheet.ListObjects("Table1"), "Critical") _
            .Slicers.Add xlSheet, , "Critical", "Critical", _
            65, 76, 75, 50
        xlBook.SlicerCaches.Add2(xlSheet.ListObjects("Table1"), "Status"). _
            Slicers.Add xlSheet, , "Status", "Status", _
            115, 1, 150, 70

        xlBook.SlicerCaches.Add2(xlSheet.ListObjects("Table1"), _
            "Outline Level").Slicers.Add xlSheet, , "Outline Level", "Outline Level", _
            185, 1, 150, 90

    'insert instructions to filter by resource
         instrNotes = "HOW TO FIND TASKS BY RESOURCE" & vbNewLine & _
            "1. Clear summary filter above to view subtasks." & vbNewLine & _
            "2. Select dropdown menu from Resource Names column." & vbNewLine & _
            "3. Type the name in the search field." & vbNewLine & _
            "4. Click Ok." & vbNewLine & _
            "5. Select dropdown menu from Resource Names column again." & vbNewLine & _
            "6. Scroll to the bottom of list." & vbNewLine & _
            "7. Select ""(blanks)""." & vbNewLine & _
            "8. Click OK." & vbNewLine & vbNewLine & _
            "- Now your subtasks and the summary tasks will appear in this schedule." & vbNewLine & _
            "- You could also use the" & vbNewLine & _
            """Who Does What"" sheet."

        xlSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
            1, 276, 149, 205).Select
        xlApp.Selection.ShapeRange.ShapeStyle = msoShapeStylePreset34
        xlApp.Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 9
        xlApp.Selection.Placement = xlFreeFloating
        xlApp.Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = instrNotes

        'Set Columns
        xlBook.SlicerCaches("Slicer_Status").Slicers("Status").NumberOfColumns = 2
        xlBook.SlicerCaches("Slicer_Critical").Slicers("Critical").NumberOfColumns = 2
        xlBook.SlicerCaches("Slicer_Milestone").Slicers("Milestone").NumberOfColumns = 2
        xlBook.SlicerCaches("Slicer_Active").Slicers("Active").NumberOfColumns = 2
        xlBook.SlicerCaches("Slicer_Summary").Slicers("Summary").NumberOfColumns = 2
        xlBook.SlicerCaches("Slicer_Outline_Level").Slicers("Outline Level").NumberOfColumns = 4

        'Set to False
        xlBook.SlicerCaches("Slicer_Active").SlicerItems("No").Selected = False
        xlBook.SlicerCaches("Slicer_Summary").SlicerItems("No").Selected = False
        xlBook.SlicerCaches("Slicer_Status").SlicerItems("Complete").Selected = False

        'Sort to be Yes, No
        xlBook.SlicerCaches("Slicer_Summary").SortItems = xlSlicerSortDescending
        xlBook.SlicerCaches("Slicer_Active").SortItems = xlSlicerSortDescending
        xlBook.SlicerCaches("Slicer_Milestone").SortItems = xlSlicerSortDescending
        xlBook.SlicerCaches("Slicer_Critical").SortItems = xlSlicerSortDescending

'WHO DOES WHAT sheet- EXCEL
    'Create PivotTable
        xlSheet.Range("b4").Select
        xlBook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            "Table1", Version:=xlPivotTableVersion15).CreatePivotTable TableDestination _
            :="Sheet3!R4C1", TableName:="PivotTable2", DefaultVersion:= _
            xlPivotTableVersion15

        With xlSheet2.PivotTables("PivotTable2").PivotFields("Resource Names")
            .Orientation = xlPageField
            .Position = 1
        End With
        With xlSheet2.PivotTables("PivotTable2").PivotFields("Start Formatted")
            .Orientation = xlRowField
            .Position = 1
        End With
        With xlSheet2.PivotTables("PivotTable2").PivotFields("ID - Name")
            .Orientation = xlRowField
            .Position = 2
        End With

        xlSheet2.PivotTables("PivotTable2").AddDataField xlSheet2.PivotTables( _
            "PivotTable2").PivotFields("Remaining Work Hrs"), "Remaining Work Hrs ", xlSum
        xlSheet2.PivotTables("PivotTable2").CompactLayoutRowHeader = _
            "Task ID - Task Name"

        'Group PivotTable Dates and collapse to level 1
        xlSheet2.Activate
        xlSheet2.Range("A5").Select
        xlApp.Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
            True, True, False, False)

        xlBook.ShowPivotTableFieldList = False
        xlSheet2.PivotTables("PivotTable2").HasAutoFormat = False
        xlSheet2.PivotTables("PivotTable2").PivotFields("Start").ShowDetail = False

    'Create timeline
        xlSheet2.Rows("1:1").RowHeight = 120
        xlBook.SlicerCaches.Add2(xlSheet2.PivotTables("PivotTable2"), _
            "Start Formatted", , xlTimeline).Slicers.Add xlSheet2, , "Start 1", "Years", _
            1, 1, 150, 108

        xlSheet2.Shapes.Range(Array("Start 1")).Select
        xlSheet2.Shapes.Range("Start 1").Duplicate.Select

        xlBook.SlicerCaches("NativeTimeline_Start_Formatted").Slicers("Start 1"). _
            TimelineViewState.Level = xlTimelineLevelYears

        xlBook.SlicerCaches("NativeTimeline_Start_Formatted").Slicers("Start 1"). _
            TimelineViewState.Level = xlTimelineLevelYears 'this doesn't always work the first time

        xlBook.SlicerCaches("NativeTimeline_Start_Formatted").Slicers("Start 2").Caption _
            = "Months"

        xlSheet2.Shapes("Start 2").IncrementLeft 141
        xlSheet2.Shapes("Start 2").IncrementTop -12
        xlSheet2.Shapes("Start 2").ScaleWidth 3, msoFalse, msoScaleFromTopLeft

        'Scroll timelines to left
        xlBook.SlicerCaches("NativeTimeline_Start_Formatted").TimelineState.SetFilterDateRange _
            Format(ActiveProject.ProjectStart, "mm/dd/yyyy"), _
            Format(DateAdd("m", 1, ActiveProject.ProjectStart), "mm/dd/yyyy")
        xlBook.SlicerCaches("NativeTimeline_Start_Formatted").ClearDateFilter
        xlSheet2.PivotTables("PivotTable2").PivotFields("Months").ShowDetail = False
        xlSheet2.Columns("A:A").ColumnWidth = 111.44

    'Create slicers
        'Active
        xlBook.SlicerCaches.Add2(xlSheet2.PivotTables("PivotTable2"), _
            "Active").Slicers.Add xlSheet2, , "Active 1", "Active", _
            1, 607, 75, 50
        xlBook.SlicerCaches("Slicer_Active1").Slicers("Active 1").NumberOfColumns = 2
        xlBook.SlicerCaches("Slicer_Active1").SlicerItems("No").Selected = False
        xlBook.SlicerCaches("Slicer_Active1").SortItems = xlSlicerSortDescending

        'Summary
        xlBook.SlicerCaches.Add2(xlSheet2.PivotTables("PivotTable2"), _
            "Summary").Slicers.Add xlSheet2, , "Summary 2", "Summary", _
            1, 680, 75, 50
        xlBook.SlicerCaches("Slicer_Summary1").Slicers("Summary 2").NumberOfColumns = 2
        xlBook.SlicerCaches("Slicer_Summary1").SlicerItems("Yes").Selected = False
        xlBook.SlicerCaches("Slicer_Summary1").SortItems = xlSlicerSortDescending

        'Status
        xlBook.SlicerCaches.Add2(xlSheet2.PivotTables("PivotTable2"), _
            "Status").Slicers.Add xlSheet2, , "Status 1", "Status", _
            1, 755, 300, 50
        xlBook.SlicerCaches("Slicer_Status1").Slicers("Status 1").NumberOfColumns = 4
        xlBook.SlicerCaches("Slicer_Status1").SlicerItems("Complete").Selected = False

        'Resource Slicer
        xlBook.SlicerCaches.Add2(xlSheet2.PivotTables("PivotTable2"), _
            "Resource Names").Slicers.Add xlSheet2, , "Resource Names 1", "Resource Names", _
            55, 712, 343, 325
        xlBook.SlicerCaches("Slicer_Resource_Names").Slicers("Resource Names 1").NumberOfColumns = 2

    'Insert instructions to use filter
        With xlSheet2.Range("b2").Interior
            .ThemeColor = xlThemeColorAccent5
            .TintAndShade = 0
        End With
        xlSheet2.Range("b2").Font.ThemeColor = xlThemeColorDark1

        xlSheet2.Shapes.AddTextbox(msoTextOrientationHorizontal, _
            607, 65, 100, 48).Select
        xlApp.Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
            "Select drop down below" & Chr(13) & _
            "Type a name to search for" & Chr(13) & _
            """Select Multiple Items""" & Chr(13) & _
            "Click Ok"
        With xlApp.Selection.ShapeRange.TextFrame2
            .TextRange.Font.Size = 8
            .VerticalAnchor = msoAnchorBottom
            .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        End With
        xlApp.Selection.ShapeRange.ShapeStyle = msoShapeStylePreset34

'Clean up Excel
    xlApp.ActiveWindow.DisplayGridlines = False

    xlSheet2.Range("a1").Select
    xlSheet.Name = "Schedule"
    xlSheet2.Name = "Who Does What When"

    xlSheet.Activate
    xlSheet.Range("a1").Select

'Clean Up Project
    On Error GoTo ErrorHandler
    RestoreOriginalSettings
    UpdatesON
    DoEvents

'Save As Dialog
    projectName = ActiveProject.Tasks.UniqueID(0).Name & " - " & _
        Format(Now(), "yyyy-mm-dd_HHmm")
    xlApp.Visible = True
    xlApp.Dialogs(xlDialogSaveAs).Show projectName

End
ErrorHandler:
HandlingErrors
End Sub

Stack Exchange Network

Report to Show Work During Current Week Only

2 Answers 2

Your Answer

Not the answer you're looking for? Browse other questions tagged
ms-project
reporting
ms-project-2010
or ask your own question.

Hot Network Questions

Report to Show Work During Current Week Only

2 Answers 2

Your Answer

Sign up or log in

Post as a guest

Not the answer you're looking for? Browse other questions tagged ms-projectreportingms-project-2010 or ask your own question.

Related

Hot Network Questions

Not the answer you're looking for? Browse other questions tagged
ms-project
reporting
ms-project-2010
or ask your own question.