VBA Microsoft Excel Export Task Usage View data to Microsoft Excel only works once

Question

I have a macro that exports Task Usage View data from Project to Excel and then formats the data. The Project data includes Timescale data. After exporting the data, it is formatted in Excel. This includes deleting rows. When the file is opened, the macro works perfectly. The data shows up in Excel exactly as intended. If the macro is tried a second time, an error occurs. The error does not always occur at the same point, but the macro stops before it gets to the last line. If the file is closed and reopened, the macro will once again work perfectly. I will attach the code.

Thanks

Sub Export_Task_Usage_View_Remaining_Cost()

'Declare Variables

Dim P As Project 

Dim ExAp As Object 

Dim ExBk As Object 

Dim ExWs As Object 

Dim s As Variant 

Dim t As Table 

Dim FileName As String 

Dim ColLtr As String 

Dim ColNum As Integer 

Dim LstRow As Integer 

Dim DelRow As Integer 

Dim Counter As Integer 

Dim Row As Integer 

'Set Variables

Set P = ThisProject 

s = "" 

pf = P.ProjectFinish 

Counter = 1 

Row = 2 

LstRow = 0 

'Create Blank Excel Workbook

Set ExAp = CreateObject("Excel.Application") 

Set ExBk = ExAp.Workbooks.Add 

Set ExWs = ExBk.Sheets(1) 

ExAp.Visible = True 

'Go to Task Usage View and Remove Filters

With Application 

    .ViewApply ("Task Usage") 

    .TableReset 

    .OutlineShowAllTasks 

    .DetailStylesRemoveAll 

    .DetailStylesAdd (0) 

    x = .TimescaleEdit(2, 255, 86) 

End With 

FilterApply Name:="All Tasks" 

'Outline Level Max

Application.OutlineShowTasks pjTaskOutlineShowLevelMax, False 

DetailStylesAdd Item:=pjCost 

'Add Resource Type

TableEditEx Name:="Usa&ge", TaskTable:=True, NewName:="", NewFieldName:="Resource Type", NewFieldName:="Resource Type", Title:="", Width:=14, Align:=0, ShowInMenu:=True, LockFirstColumn:=True, DateFormat:=255, RowHeight:=1, ColumnPosition:=7, AlignTitle:=0 

TableApply Name:="Usa&ge" 

SelectCell Row:=1, RowRelative:=False 

'Prepare Details Pane date range to copy, from user input start date (s) to Project Finish

Do Until IsDate(s) 

  s = InputBox("Please enter date to start copying from details pane") 

Loop 

d = 1 + (Month(pf) - Month(s)) + (12 \* (Year(pf) - Year(s))) 

'Add Month Headers to Excel

For hdrs = 0 To (d - 1) 

 ExWs.Cells(1, hdrs + 5).Value = DateAdd("m", hdrs, s) 

 ExWs.Cells(1, hdrs + 5).NumberFormat = "[$-en-US]mmm-yy;@" 

 ExWs.Cells(1, hdrs + 5).Font.Name = "Segoe UI" 

 ExWs.Cells(1, hdrs + 5).Font.Size = 9 

 ExWs.Cells(1, hdrs + 5).Interior.Color = RGB(223, 227, 232) 

Next hdrs 

ColNum = ExWs.UsedRange.Columns(ExWs.UsedRange.Columns.Count).Column 

ColLtr = Split(ExWs.Cells(1, ColNum).Address, "$")(1) 

'Add Task Info to Excel

ExWs.Columns("A").ColumnWidth = 30 

ExWs.Columns("B:D").ColumnWidth = 16 

Application.SelectTaskColumn ("Name") 

EditCopy 

ExWs.Cells(1, 1).Select 

ExWs.Paste 

Application.SelectTaskColumn ("Start") 

EditCopy 

ExWs.Cells(1, 2).Select 

ExWs.Paste 

Application.SelectTaskColumn ("Finish") 

EditCopy 

ExWs.Cells(1, 3).Select 

ExWs.Paste 

Application.SelectTaskColumn ("Resource Type") 

EditCopy 

ExWs.Cells(1, 4).Select 

ExWs.Paste 

LstRow = Selection.Rows.Count 

PaneNext 

SelectTimescaleRange Row:=1, StartTime:=s, Width:=d, Height:=50000 

EditCopy 

ExWs.Cells(2, 5).Select 

ExWs.Paste 

Do While Counter < LstRow 

    ExWs.Cells(Row, 4).Select 

        If Selection.Value = "Work" Then 

            DelRow = Selection.Row + 1 

            ExWs.Range(Cells(DelRow, 5), Cells(DelRow, ColNum)).Select 

            Selection.Delete Shift:=xlUp 

        ElseIf Selection.Value = "Cost" Then 

            DelRow = Selection.Row 

            ExWs.Range(Cells(DelRow, 5), Cells(DelRow, ColNum)).Select 

            Selection.Delete Shift:=xlUp 

        ElseIf Selection.Value = "Material" Then 

            DelRow = Selection.Row 

            ExWs.Range(Cells(DelRow, 5), Cells(DelRow, ColNum)).Select 

            Selection.Delete Shift:=xlUp 

        Else 

            DelRow = Selection.Row 

            ExWs.Range(Cells(DelRow, 5), Cells(DelRow + 1, ColNum)).ClearContents 

            ExWs.Range(Cells(DelRow, 5), Cells(DelRow, ColNum)).Select 

            Selection.Delete Shift:=xlUp 

        End If 

        Row = Row + 1 

        Counter = Counter + 1 

Loop 

'Reset Variables and Task Usage View

ExWs.Columns("E:" & ColLtr).Replace What:="hrs", Replacement:="" 

ExWs.Columns("E:" & ColLtr).Replace What:="hr", Replacement:="" 

ExWs.Columns("E:" & ColLtr).ColumnWidth = 14 

ExWs.Cells(1, 4).Select 

Selection.EntireColumn.Delete 

LstRow = 0 

Set ExBk = Nothing 

Set ExAp = Nothing 

DetailStylesRemove Item:=pjCost 

End Sub

Answer 1

John Sullivan5,

I can help you on this one but it may take a while as I have other priorities.

Thanks for posting your full code. I see it does a lot of copy and paste directly from the view instead of a much more efficient use of the TimescaleData Method. It's quite likely I have a macro that will do what you want to do in a more efficient and reliable way. When I get a chance I'll test your code on a sample file and go from there.

Update: I did a couple of quick runs using your macro and it kinda works but it does have some issues (e.g. the timescale header in Excel adds an extra period when there is no Project data for that period and there is a bunch of extraneous data in Excel that is below and to the right of the main exported data)

Since technical issues such as this aren't the prime focus of this forum, I suggest we work one-on-one via e-mail. You can contact me at the address below. I will ask some questions.

John

jmacprojataticlouddotdotcom

(remove obvious redundancies)