Solved: Exporting Data to Excel for reporting purposes

[chris338]

I'm new here and a relative VBA newbie. I've read some VBA books and tried to cobble together VBA programs, but just find it really difficult. I am determined to learn it, but in the meantime, I really need this macro to work to fulfill a work requirement.

In MS Project 2007, I created a couple of custom fields to mark whether the task had a deliverable that was external to us or not. I used the Text11 field with a drop down of either Internal or External. But in reality, I've only put the data "External" in that field. If it is Internal, it is blank. I then used the Text10 field to identify the external department we need the information from.

I want to test on every task in the project whether or not the Text11 field has a value. If it has a value of "External" then I want to pull other data from that task row into Excel. If not, I want to skip that task row.

Using a book called, VBA Programming for Microsoft Office Project Version 98 through 2007, I have part of the macro written that opens up excel and puts the field names in there. What I still need help with is getting the actual data to come over. I'm doing something wrong with the data types and I'm still fuzzy on how the author is assigning field properties to variables. There's some type of mismatch there that I'm missing. I'm posting the code I have so far, but it really breaks down near the end. Any help would be appreciated.

I just read another post about exporting to Excel. I have noted the reference library for Excel in the MS Project VBA editor:
[IMG]file:///C:/DOCUME%7E1/sneedc/LOCALS%7E1/Temp/moz-screenshot.jpg[/IMG]


Sub ExportMasterScheduleData()
'Start Excel and create a new workbook
'Create column titles
'Export data and the project title
'Tidy up
Dim xlApp As Excel.Application
Dim xlRange As Excel.Range
Dim Dept As Task


'Start Excel and create a new workbook
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.Add

'Create column titles
Set xlRange = xlApp.Range("A1")
With xlRange
.Formula = "Master Schedule Report"
.Font.Bold = True
.Font.Size = 12
.Select
End With

xlRange.Range("A2") = "WBS"
xlRange.Range("B2") = "Project Name"
xlRange.Range("C2") = "Owner"
xlRange.Range("D2") = "Start"
xlRange.Range("E2") = "End"
xlRange.Range("F2") = "Dependencies"
xlRange.Range("G2") = "Dependency Owner"
xlRange.Range("H2") = "Need Date"
xlRange.Range("I2") = "Last Update"
xlRange.Range("J2") = "Deliverables"
xlRange.Range("K2") = "Deliverable Owners"
xlRange.Range("L2") = "Ready Date"""
xlRange.Range("M2") = "ECD"
xlRange.Range("N2") = "Notes"
With xlRange.Range("A2:N2")
.Font.Bold = True
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With

'Export data and the project title
Set xlRange = xlRange.Range("A3")
For Each Dept In ActiveProject.Tasks
If Not Dept Is Nothing Then
With xlRange
.Range("A3") = Dept.WBS
.Range("B3") = ActiveProject.Name
.Range("C3") = Resource.Name
.Range("D3") = Dept.Start
.Range("E3") = Dept.Finish
.Range("G3") = Dept.Text10
.Range("H3") = Dept.Finish
End With
End If
Set xlRange = xlRange.Offset(1, 0) 'Point to next row
Next Dept.Text10
'Tidy up
xlRange.Range("A3:H3").EntireColumn.AutoFit
Set xlApp = Nothing
End Sub

[chris338]

I have everything solved except for the following:
I have this code tweaked from Rod Gill almost perfect. It is exporting tasks
to an Excel spreadsheet, Unfortunately, I am trying to get it to filter on
the custom field, Text11. If it has a value of "External" then export data
from that task. Otherwise, ignore it and find the next task with that field
set to "External." I've tried every combination for the last 2 hours now and
I just can't get it to filter. Help! Here's the last bit of code that SHOULD somehow filter on Task.Text11:

'Export data and the project title
Set xlRange = xlRange.Range("A3")
For Each Dept In ActiveProject.Tasks
Check = Dept.Text11
If Not Check = "0" Then
With xlRange
.Range("A3") = Dept.WBS
.Range("B3") = ActiveProject.Name
.Range("C3") = Dept.ResourceNames
.Range("D3") = Dept.Start
.Range("E3") = Dept.Finish
.Range("F3") = Check
.Range("G3") = Dept.Text10
.Range("H3") = Dept.Finish
.Range("O3") = Dept.Text11
End With
Else: End If
Set xlRange = xlRange.Offset(1, 0) 'Point to next row
Check = ""
Next Dept

[chris338]

I received more timely answers from the Microsoft forum here (remove all dashes):
h-t-t-p:-/-/-t-i-n-y-u-r-l-.-c-o-m-/-k-q-2-e-t-x

They helped me arrive at the right solution. I'm posting the code in case someone else wants to use it:

Dim xlApp As Excel.Application
Dim xlRange As Excel.Range
Dim Dept As Task
Dim Check As String

Sub ExportMasterScheduleData()
'Start Excel and create a new workbook
'Create column titles
'Export data and the project title
'Tidy up


'Start Excel and create a new workbook
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    xlApp.Workbooks.Add
    
'Create column titles
    Set xlRange = xlApp.Range("A1")
    With xlRange
        .Formula = "Master Schedule Report"
        .Font.Bold = True
        .Font.Size = 12
        .Select
    End With
    
xlRange.Range("A2") = "Project"
xlRange.Range("B2") = "Dependency"
xlRange.Range("C2") = "Notes"
xlRange.Range("D2") = "Need Date Last Updated"
xlRange.Range("E2") = "Need Date"
xlRange.Range("F2") = "Deliverable ECD"
xlRange.Range("G2") = "Status"
xlRange.Range("H2") = "Deliverable Owner"
With xlRange.Range("A2:N2")
    .Font.Bold = True
    .HorizontalAlignment = xlHAlignCenter
    .VerticalAlignment = xlVAlignCenter
    .EntireColumn.AutoFit
    .Select
End With

'Export data and the project title
    Set xlRange = xlRange.Range("A3") 'Set cursor to the right spot in the worksheet
    ViewApply Name:="Chris Baseline Gantt View" 'Get the view that has the Text11 column to filter on
    OutlineShowAllTasks 'Any hidden tasks won't be selected, so be sure all tasks are showing
    FilterApply Name:="External Tasks" 'This custom filter selects "External"
    SelectTaskColumn ("Text11") 'Insures the For Each loop gets all of the filtered tasks, this may be redundant
    For Each Dept In ActiveSelection.Tasks 'Pulls data for each task into spreadsheet
            With xlRange
                .Range("A3") = ActiveProject.Name
                .Range("B3") = Dept.Name
                .Range("C3") = Dept.Notes
                .Range("E3") = Dept.Finish
                .Range("H3") = Dept.Text10
            End With
            Set xlRange = xlRange.Offset(1, 0) 'Point to next row
    Next Dept
'Tidy up
ViewApply Name:="Chris Baseline Gantt View"
FilterApply Name:="External Tasks"
With xlRange
    .Range("A3").ColumnWidth = 30
    .Range("B3").ColumnWidth = 50
    .Range("B3").EntireColumn.WrapText = True
    .Range("C3").ColumnWidth = 30
    .Range("E3").ColumnWidth = 20
    .Range("C3").EntireColumn.WrapText = True
End With
Set xlApp = Nothing
End Sub