Create project plan and actual data table based on the Primavera P6 Xer file using Excel VBA and SQL

This page discusses how to create the project plan and actual data table based on the Primavera P6 Xer file using Excel VBA and SQL. It is presumed that the project Xer file has been made available and parsed to every distinct data table. How to read and parse the xer file is discussed on the page Xer (P6 text file) written to Excel.

Project summary

1. view the list of data and initiate a program running

The data to be covered by the project data table are viewed on the Userform for reference.

  1. Schedule data: Activity Start, Finish, Actual Start, Actual Finish, Remain Start, Remain Finish
  2. Labor in hours: Budget, Actual, Earned Value, Remaining
  3. Non-labor in hours: Budget, Actual, Remaining
  4. Projct cost: Budget, Actual, Remaining

Calendar Userform

1.1 Prepopulate the Userform with the selected project and the list of data

Sub PRAP_DataBase()
    Set wba = Workbooks("PRAP.xlam"): Set wsa = wba.Worksheets("xer")
    Set wb = ActiveWorkbook: Set ws = wb.ActiveSheet
    If wsa.Cells(1, 1) <> "" Then
        Filename = wsa.Cells(1, 1).Value
    Else
        Call Choose_XerFile
    End If
    Dateformat = DateformatProcedure
    Call ImportXer 'run import and create data tables
    If wsa.Cells(2, 1) <> "" Then
        ProjectID = wsa.Cells(2, 1).Value
        ProjectName = wsa.Cells(2, 2).Value
    Else
        MsgBox "A project to work with is required. Select an Icon ""Project Summary"" on the Ribbon."
        Exit Sub
    End If
    With uf_PRAPDB
        .Label1.Caption = "Xer File: " & Filename
        .Label2.Caption = "Project ID: " & ProjectID
        .Label3.Caption = "Project Name: " & ProjectName
        .CommandButton1.Enabled = False
        With .ListBox1
            .List = Array("Start", "Finish", "Actual Start", "Actual Finish", "Remain Start", "Remain Finish")
        End With
        With .ListBox2
            .List = Array("Budget", "Actual", "Earned Value", "Remaining")
        End With
        With .ListBox3
            .List = Array("Budget", "Actual", "Remaining")
        End With
        With .ListBox4
            .List = Array("Budget", "Actual", "Remaining")
        End With
        .CommandButton1.Enabled = True
        .Show vbModeless
    End With
End Sub

1.2 Press OK button to run the program

Private Sub CommandButton1_Click()
    Call WBSHierarchy
    Call PRPTask_list
    MsgBox "PRAP Source data table is generated"
End Sub

2. Create project summary of the selected project

2.1 Struture the WBS heierarchy of every activity

Sub WBSHierarchy()
    'Create myWBS data ble containing the path of hierarchical level order
    Dim i As Long, j As Long, K As Long, r As Long, c As Long
    Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, n5 As Long
    Dim p1 As String, p2 As String, p3 As String, p4 As String, p5 As Long
    Dim ws As Worksheet
     
    r = UBound(myTable(iPROJWBS))
    c = UBound(myTable(iPROJWBS), 2)
    
    Dim iproj_id As Long, iwbs_id As Long, iparent_wbs_id As Long
    For i = 1 To c
        If myTable(iPROJWBS)(2, i) = "proj_id" Then
            iproj_id = i
        End If
        If myTable(iPROJWBS)(2, i) = "wbs_id" Then
            iwbs_id = i
        End If
        If myTable(iPROJWBS)(2, i) = "parent_wbs_id" Then
            iparent_wbs_id = i
        End If
    Next i
    
    n = 0
    For i = 3 To r
        If myTable(iPROJWBS)(i, iproj_id) = CStr(ProjectID) Then
            n = n + 1
        End If
    Next i
    
    Dim myWBSTemp() As Variant
    Erase myWBSTemp
    ReDim Preserve myWBSTemp(n + 1 + 1, c + 3)
    
    myWBSTemp(1, 1) = "myWBS"
    For i = 1 To c
        myWBSTemp(2, i) = myTable(iPROJWBS)(2, i)
    Next i
    
    myWBSTemp(2, c + 1) = "path"
    myWBSTemp(2, c + 2) = "level"
    myWBSTemp(2, c + 3) = "order"
    
    n = 0
    For i = 3 To UBound(myTable(iPROJWBS))
        If myTable(iPROJWBS)(i, 2) = CStr(ProjectID) Then
            n = n + 1
            For j = 1 To c
                myWBSTemp(n + 2, j) = myTable(iPROJWBS)(i, j)
            Next j
        End If
    Next i
     
    For i = 3 To UBound(myWBSTemp)
        p1 = myWBSTemp(i, iparent_wbs_id)
        n1 = 0
        For j = 1 To UBound(myWBSTemp)
            If myWBSTemp(j, iwbs_id) = CStr(p1) Then
                n1 = n1 + 1
                If n1 = 1 Then
                    n1 = j
                    Exit For
                End If
            End If
        Next j
        If n1 > 0 Then
            p2 = myWBSTemp(n1, iparent_wbs_id)
            n2 = 0
            For j = 1 To UBound(myWBSTemp)
                If myWBSTemp(j, iwbs_id) = CStr(p2) Then
                    n2 = n2 + 1
                    If n2 = 1 Then
                        n2 = j
                        Exit For
                    End If
                End If
            Next j
        End If
        If n2 > 0 Then
            p3 = myWBSTemp(n2, iparent_wbs_id)
            n3 = 0
            For j = 1 To UBound(myWBSTemp)
                If myWBSTemp(j, iwbs_id) = CStr(p3) Then
                    n3 = n3 + 1
                    If n3 = 1 Then
                        n3 = j
                        Exit For
                    End If
                End If
            Next j
        End If
        If n3 > 0 Then
            p4 = myWBSTemp(n3, iparent_wbs_id)
            n4 = 0
            For j = 1 To UBound(myWBSTemp)
                If myWBSTemp(j, iwbs_id) = CStr(p4) Then
                    n4 = n4 + 1
                    If n4 = 1 Then
                        n4 = j
                        Exit For
                    End If
                End If
            Next j
        End If
        If n4 > 0 Then
            p5 = myWBSTemp(n4, iparent_wbs_id)
            n5 = 0
            For j = 1 To UBound(myWBSTemp)
                If myWBSTemp(j, iwbs_id) = CStr(p5) Then
                    n5 = n5 + 1
                    If n5 = 1 Then
                        n5 = j
                        Exit For
                    End If
                End If
            Next j
        End If
        Select Case 0
            Case n1 'Level 1 activity
                myWBSTemp(i, c + 1) = myWBSTemp(i, iparent_wbs_id) & "|" & myWBSTemp(i, iwbs_id)
                myWBSTemp(i, c + 2) = 1
                myWBSTemp(i, c + 3) = i
            Case n2 'Level 2 activity
                myWBSTemp(i, c + 1) = p2 & "|" & myWBSTemp(i, iparent_wbs_id) & "|" & myWBSTemp(i, iwbs_id)
                myWBSTemp(i, c + 2) = 2
                myWBSTemp(i, c + 3) = i
            Case n3 'Level 3 activity
                myWBSTemp(i, c + 1) = p3 & "|" & p2 & "|" & myWBSTemp(i, iparent_wbs_id) & "|" _
                & myWBSTemp(i, iwbs_id)
                myWBSTemp(i, c + 2) = 3
                myWBSTemp(i, c + 3) = i
            Case n4 'Level 4 mactivity
                myWBSTemp(i, c + 1) = p4 & "|" & p3 & "|" & p2 & "|" & myWBSTemp(i, iparent_wbs_id) _
                & "|" & myWBSTemp(i, iwbs_id)
                myWBSTemp(i, c + 2) = 4
                myWBSTemp(i, c + 3) = i
            Case n5 'Level 5 activity
                myWBSTemp(i, c + 1) = p5 & "|" & p4 & "|" & p3 & "|" & p2 & "|" & myWBSTemp(i, iparent_wbs_id) _
                & "|" & myWBSTemp(i, iwbs_id)
                myWBSTemp(i, c + 2) = 5
                myWBSTemp(i, c + 3) = i
        End Select
        Dim iwbs_name As Integer, iorder As Integer, ilevel As Integer, ipath As Integer
        Erase myWBS
        ReDim Preserve myWBS(UBound(myWBSTemp), 6)
        For j = 1 To UBound(myWBSTemp, 2)
            Select Case myWBSTemp(2, j)
                Case "wbs_id"
                    iwbs_id = j
                Case "wbs_name"
                    iwbs_name = j
                Case "order"
                    iorder = j
                Case "level"
                    ilevel = j
                Case "path"
                    ipath = j
                Case "proj_id"
                    iproj_id = j
            End Select
        Next j
'        Erase myWBSTemp
'        myWBS(1, 1) = "myWBS"
        For j = 1 To UBound(myWBSTemp)
            myWBS(j, 1) = myWBSTemp(j, iwbs_id)
            myWBS(j, 2) = myWBSTemp(j, iwbs_name)
            myWBS(j, 3) = myWBSTemp(j, iorder)
            myWBS(j, 4) = myWBSTemp(j, ilevel)
            myWBS(j, 5) = myWBSTemp(j, ipath)
            myWBS(j, 6) = myWBSTemp(j, iproj_id)
        Next j
    Next i
    Erase myWBSTemp
End Sub

2.2 Consolidate project plan and actual data of activities sorted in the same order as P6 project schedule

Load data worksheet

Sub PRPTask_list()
    Dim strSql1 As String
    Dim Temp As Variant, myTemp As Variant
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .StatusBar = "Please wait..."
    End With
'*******************************************************
'1. Load data worksheet
'*******************************************************
    
    wshtName = myTable(iCALENDAR)(1, 1)
    Call AddWorksheet(wshtName, myTable(iCALENDAR))
    wshtName = myWBS(1, 1)
    Call AddWorksheet(wshtName, myWBS)
    wshtName = myTable(iTask)(1, 1)
    Call AddWorksheet(wshtName, myTable(iTask))
    wshtName = myTable(iPROJECT)(1, 1)
    Call AddWorksheet(wshtName, myTable(iPROJECT))
    wshtName = myTable(iTASKRSRC)(1, 1)
    Call AddWorksheet(wshtName, myTable(iTASKRSRC))

Create a new task list based on xer data file

 '*******************************************************
 '2. Create a new task list based on xer data file
 '********************************************************
    Temp = Array("task_id", "task", "Order", "Level", "wbs_id", "path", "Activity ID", "Activity Name", _
        "target_labor", "Actual_Labor", "Remaining", "At_Completion", "od", "Start", "restart_Date", "Finish", _
         "Act_Start", "Act_Finish", "Total_Float", "Duration_Pct", "Activity_Pct", "Labor_Earned_Value", _
         "target_Non_labor", "Actual_Non_Labor", "Remaining_Non_Labor", "At_Completion_Non_Labor", "target_cost", "Actual_cost", "Remain_Cost", "At_Completion_cost")

    strSql1 = "SELECT [task_id],1,val([Order]),'', [TASK$].[wbs_id],[Path],[task_code],[task_name],val([target_work_qty])," & _
        "val([act_work_qty]),[remain_work_qty],(val([act_work_qty])+[remain_work_qty]),iif(val([target_drtn_hr_cnt])=0,0.0000001, " & _
        "val([target_drtn_hr_cnt]))," & _
        "iif(isnull([act_start_date]),cdate([early_start_date]),cdate([act_start_date])) AS [start], cdate([restart_date]) as [restart],iif(isnull([act_end_date]),cdate([early_end_date]),cdate([act_end_date])) AS [finish]," & _
        "cdate([act_start_date]),cdate([act_end_date])," & _
        "(([total_float_hr_cnt])/[day_hr_cnt]) AS [TF_days]," & _
        "iif(( Val([target_drtn_hr_cnt])= 0 OR val([target_drtn_hr_cnt])  val([remain_drtn_hr_cnt])),0, " & _
        "cdbl(cdbl(val([target_drtn_hr_cnt])-val([remain_drtn_hr_cnt]))/cdbl(val([target_drtn_hr_cnt])))) as [D_percent]," & _
        "iif([complete_pct_type]='CP_Drtn',[D_percent],iif([complete_pct_type]='CP_Phys',cdbl(val([phys_complete_pct]))/100,iif(val([remain_work_qty])+ " & _
        "val([act_work_qty])+val([remain_equip_qty])+val([act_equip_qty])=0,0,cdbl((val([act_work_qty])+val([act_equip_qty]))/cdbl([remain_work_qty]+val([act_work_qty])+val([remain_equip_qty])+ " & _
        "val([act_equip_qty])))))) as [percent] " & _
        " ,(val([act_work_qty])+[remain_work_qty])* [percent],val([target_equip_qty]), val([act_equip_qty]),val([remain_equip_qty]),(val([act_equip_qty])+val([remain_equip_qty])) " & _
        " FROM  ([TASK$] INNER JOIN [CALENDAR$] ON [TASK$].[clndr_id] = [CALENDAR$].[clndr_id]) " & _
        "INNER JOIN [myWBS$] on [TASK$].[wbs_id] = [myWBS$].[wbs_id] WHERE  cstr([TASK$].[proj_id]) = " & ProjectID & "  "
    
    myTemp = QueryResultArray(strSql1)
    r = UBound(myTemp)
    
    Dim myTaskpre() As Variant
    Erase myTaskpre
    ReDim Preserve myTaskpre(r + 2, 26 + 4)
    myTaskpre(1, 1) = "myTask"
    For i = 1 To 26 + 4
        myTaskpre(2, i) = Temp(i)
    Next i
    For i = 1 To r
        For j = 1 To 26
            myTaskpre(2 + i, j) = myTemp(i, j)
        Next j
    Next i
    Erase Temp
    Erase myTemp

Create Cost data to append to the new task list

'*************************************************
'3. Create Cost data to append to the new task list
'*************************************************
    Dim ddef_cost_per_qty As Double, def_cost_per_qty As Variant
    strSql1 = "SELECT [def_cost_per_qty] from [PROJECT$] where cstr([proj_id]) = " & ProjectID & ""
    def_cost_per_qty = QueryResultArray(strSql1)
    ddef_cost_per_qty = def_cost_per_qty(1, 1)
    Erase def_cost_per_qty
    
    If TASKRSRC = False Then
        strsql = "SELECT [task_id], sum(([target_work_qty]+[target_equip_qty])* " & ddef_cost_per_qty & " ) AS [Sum_target_cost]," & _
        "sum(([act_work_qty]+[act_equip_qty])* " & ddef_cost_per_qty & " ) AS [Sum_Act_cost], " & _
        "sum(([remain_work_qty]+[remain_equip_qty])* " & ddef_cost_per_qty & " ) AS [Sum_Remaining_cost], " & _
        "[Sum_Act_cost]+[Sum_Remaining_cost] AS [Sum_Completion_cost]" & _
        "from [TASK$] where cstr([proj_id]) = " & ProjectID & " GROUP BY [TASK$].[task_id] "
    End If
    If TASKRSRC = True Then
        strSQL2 = "SELECT [task_id],sum(val([target_cost])) AS [Sum_target_cost]," & _
             "sum(val([act_ot_cost])+ val([act_reg_cost])) AS [Sum_Act_cost],sum(val([remain_cost])) " & _
             "AS [Sum_Remaining_cost],[Sum_Act_cost]+[Sum_Remaining_cost] AS [Sum_Completion_cost]" & _
             "from [TASKRSRC$] where cstr([proj_id]) = " & ProjectID & " GROUP BY [task_id] "
        strSQL3 = "SELECT [TASK$].[task_id], sum(([target_work_qty]+[target_equip_qty])* " & ddef_cost_per_qty & " ) AS [Sum_target_cost]," & _
            "sum(([act_work_qty]+[act_equip_qty])* " & ddef_cost_per_qty & " ) AS [Sum_Act_cost], " & _
            "sum(([remain_work_qty]+[remain_equip_qty])* " & ddef_cost_per_qty & " ) AS [Sum_Remaining_cost], " & _
            "[Sum_Act_cost]+[Sum_Remaining_cost] AS [Sum_Completion_cost]" & _
            "from [TASK$] LEFT JOIN [TASKRSRC$] ON [TASK$].[task_id] = [TASKRSRC$].[task_id] WHERE isnull([TASKRSRC$].[task_id]) and cstr([TASK$].[proj_id]) = " & ProjectID & " " & _
            "GROUP BY [TASK$].[task_id] "
        strSQL4 = "SELECT   t1.[task_id], ([target_work_qty]+[target_equip_qty]-t2.[sum_target_qty]) * " & ddef_cost_per_qty & "   AS [Sum_target_cost], " & _
            "([act_work_qty]+[act_equip_qty]-t2.[sum_act_qty])* " & ddef_cost_per_qty & "  AS [Sum_Act_cost], " & _
            "([remain_work_qty]+[remain_equip_qty]-t2.[sum_remain_qty])* " & ddef_cost_per_qty & "  AS [Sum_Remaining_cost], " & _
            "[Sum_Act_cost]+[Sum_Remaining_cost] AS [Sum_Completion_cost]" & _
            "from [TASK$] as t1 INNER JOIN (SELECT [task_id], sum([target_qty]) as [sum_target_qty], sum(val([act_ot_qty])+val([act_reg_qty])) as [sum_act_qty],sum([remain_qty]) as [sum_remain_qty]  from [TASKRSRC$] where cstr([proj_id]) = " & ProjectID & " GROUP BY [task_id] ) as t2 " & _
            " ON t1.[task_id] = t2.[task_id]"
        strsql = strSQL2 & " UNION ALL " & strSQL3 & " UNION ALL " & strSQL4
    End If
    If PROJCOST = True Then
        strSQL5 = "SELECT [task_id],[target_cost] AS [Sum_target_cost],[act_cost] AS [Sum_Act_cost] " & _
            " ,[remain_cost] AS [Sum_Remaining_cost], [act_cost] + [remain_cost] AS [Sum_Completion_cost] from [PROJCOST$] where cstr([proj_id]) = " & ProjectID & ""
        strsql = strsql & " UNION ALL " & strSQL5
    Else
        strSQLFinal = "SELECT [task_id],  sum([Sum_target_cost]) AS [target_cost], " & _
         "sum([Sum_Act_cost]) AS [Actual_cost], sum([Sum_Remaining_cost])AS [remain_cost]" & _
         ",sum([Sum_Completion_cost]) AS [At_Completion_cost] from (" & strsql & ") GROUP BY [task_id]"
    End If
    
    Dim Tempcost As Variant
    Tempcost = QueryResultArray(strSQLFinal)
    
    For i = 3 To UBound(myTaskpre)
        DoEvents
        For j = 1 To UBound(Tempcost)
            If myTaskpre(i, 1) = Tempcost(j, 1) Then
                myTaskpre(i, 27) = Tempcost(j, 2)
                myTaskpre(i, 28) = Tempcost(j, 3)
                myTaskpre(i, 29) = Tempcost(j, 4)
                myTaskpre(i, 30) = Tempcost(j, 5)
                Exit For
            End If
        Next j
    Next i
    Erase Tempcost
 

Roll up data for each distinct paths.

 
'*************************************************************
'4. Roll up data for each distinct paths.
'*************************************************************
    Call DeleteWorksheet("myTask")
    wshtName = myTaskpre(1, 1)
    Call AddWorksheet(wshtName, myTaskpre)
    Dim HighLevelWBS As Variant
    
    Dim A1 As String, A2 As String, A3 As String, A4 As String, A5 As String, A6 As String, A7 As String, A8 As String
        A2 = ",sum(val([target_labor])) as [sum_target_labor], sum([Actual_Labor]) as [sum_Actual_Labor],sum([Remaining]) as [sum_Remaining],sum([At_Completion])  as [sum_At_Completion] "
        A3 = ",sum([od]) as [sum_T_OD] ,min([Start])as [M_Start],min(iif(not isnull([restart_date]),cdate([restart_date]),[restart_date])) as [M_restart] "
        A4 = ",max([Finish]) as [M_Finish],min([Act_Start]) as [M_Act_Start],max([Act_Finish]) as [M_Act_Finish],min([Total_Float]) as [Min_Total_Float]"
        A5 = ",iif([T_AC]=0,0,sum([At_Completion_cost]*[Activity_Pct])/[T_AC]) AS [A_Pct], sum([Labor_Earned_Value]) AS [sum_Labor_Earned_Value] "
        A6 = ",sum(val([target_Non_labor])) as [sum_target_Non_labor],sum(val([Actual_Non_Labor])) as [sum_Actual_Non_Labor]"
        A7 = ",sum(val([Remaining_Non_Labor])) as [sum_Remaining_Non_Labor],sum(val([At_Completion_Non_Labor])) as [sum_At_Completion_Non_Labor] "
        A8 = ",sum([target_cost]) as [sum_target_cost],sum([Actual_cost]) as[sum_Actual_cost],sum([remain_cost]) as[sum_remain_cost],sum([At_Completion_cost])as [T_AC] "
    
    strSql1 = "SELECT 'NA' AS [task_id],0 as [task],val([myWBS$].[Order]) as [order],[myWBS$].[Level],[myWBS$].[wbs_id],[myWBS$].[Path],[myWBS$].[wbs_name],'' as [Activity Name] " & _
        A2 & A3 & A4 & A5 & A6 & A7 & A8 & _
        "from [myWBS$] inner JOIN [myTask$] ON [myTask$].[wbs_id] =  [myWBS$].[wbs_id] " & _
        "GROUP BY [myWBS$].[Path],[myWBS$].[Order],[myWBS$].[Level],[myWBS$].[wbs_id],[myWBS$].[wbs_name]"

    strSQL2 = "SELECT 'NA' AS [task_id],0 as [task],val(t1.[Order]),t1.[Level],t1.[wbs_id],t1.[Path],t1.[wbs_name],'' as [Activity Name],sum([sum_target_labor]), sum([sum_Actual_Labor]),sum([sum_Remaining]),sum([sum_At_Completion])" & _
         ",sum([sum_T_OD]) as [T_OD] ,min([M_Start])as [M_M_Start],min([M_restart])as [M_M_restart],max([M_Finish]) as [M_M_Finish],min([M_Act_Start]) as [M_M_Act_Start],max([M_Act_Finish]) as [M_M_Act_Finish],min([Min_Total_Float])," & _
         "iif([Sum_T_AC]=0,0,sum([T_AC]*[A_Pct])/[Sum_T_AC] ) AS [sum_A_Pct], sum([sum_Labor_Earned_Value]) ,sum([sum_target_Non_labor]),sum([sum_Actual_Non_Labor]),sum([sum_Remaining_Non_Labor]),sum([sum_At_Completion_Non_Labor]), " & _
         "sum([sum_target_cost]),sum([sum_Actual_cost]),sum([sum_remain_cost]),sum([T_AC]) as [Sum_T_AC] from [myWBS$] as t1 " & _
         "inner JOIN (" & strSql1 & ") as t2 ON (t2.[Path] like t1.[Path] & '|%'  ) " & _
         " GROUP BY t1.[Path],t1.[Order],t1.[Level],t1.[wbs_id],t1.[wbs_name]"
    strSQL3 = strSql1 & " UNION ALL " & strSQL2

    strsql = "SELECT [task_id],[task],[Order],[Level],[wbs_id],[Path],[wbs_name],'',sum([sum_target_labor]),sum([sum_Actual_Labor]),sum([sum_Remaining]),sum([sum_At_Completion])," & _
            " sum([sum_T_OD]) as [T_OD] ,min([M_Start])as [M_M_Start],min([M_restart])as [M_M_restart],max([M_Finish]) as [M_M_Finish],min([M_Act_Start]),iif([Duration_Pct] =1 ,max([M_Act_Finish]),0),min([Min_Total_Float])," & _
            "iif(isnull([M_M_restart]),1,iif(([M_M_restart]-[M_M_start])/([M_M_Finish]-[M_M_Start]) 0,0,iif(([M_M_restart]-[M_M_start])/ " & _
            "([M_M_Finish]-[M_M_Start]) 1,1,([M_M_restart]-[M_M_start])/([M_M_Finish]-[M_M_Start])))) as [Duration_Pct]," & _
            "iif([sum_T_AC]=0,0,sum([T_AC]*[A_Pct])/[sum_T_AC]) AS [sum_A_Pct], sum([sum_Labor_Earned_Value]), " & _
            "sum([sum_target_Non_labor]),sum([sum_Actual_Non_Labor]),sum([sum_Remaining_Non_Labor]),sum([sum_At_Completion_Non_Labor])," & _
            "SUM([sum_target_cost]),SUM([sum_Actual_cost]),SUM([sum_remain_cost]),SUM([T_AC]) as [sum_T_AC] " & _
            "from (" & strSQL3 & ") GROUP BY [task],[Path],[Order],[Level],[wbs_id],[wbs_name],[task_id]"

    HighLevelWBS = QueryResultArray(strsql)
        
    Erase myTask
    Dim T As Long, H As Long
    T = UBound(myTaskpre): H = UBound(HighLevelWBS)
    ReDim Preserve myTask(T + H, 30)
    For i = 1 To T
        For j = 1 To 30
            myTask(i, j) = myTaskpre(i, j)
        Next j
    Next i
    Erase myTaskpre
    For i = 1 To H
        For j = 1 To 30
            myTask(T + i, j) = HighLevelWBS(i, j)
        Next j
    Next i
    Erase HighLevelWBS
    
    Call DeleteWorksheet("TASK")
    Call DeleteWorksheet("CALENDAR")
    Call DeleteWorksheet("myWBS")
    Call DeleteWorksheet("TASKRSRC")
    Call DeleteWorksheet("PROJECT")
    Call DeleteWorksheet("myTask")

Generate data table data

   
'*********************************************
'5. Generate data table data
'*********************************************
    wshtName = myTask(1, 1)
    Call AddWorksheet(wshtName, myTask)
    
    strsql = "SELECT [task],[Order],[Level],[Activity ID],[Activity Name]" & _
            ",[Start],[Finish],[Total_Float],cdate([Act_Start]) as [Actual Start] " & _
            ",cdate(iif([Act_Finish]=0,'',[Act_Finish])) as  [Actual_Finish],[restart_date],'' as [Forecast Finish],[Duration_Pct]" & _
            ",[target_labor],[Actual_Labor],[Remaining],[At_Completion]" & _
            ",[Activity_Pct],[Labor_Earned_Value]" & _
            ",[target_Non_labor],[Actual_Non_Labor],[Remaining_Non_Labor],[At_Completion_Non_Labor]" & _
            ",[target_cost],[Actual_cost],[remain_cost],[At_Completion_cost]" & _
            "from [myTask$] order by [order],[task],[start]"
            
    Dim DataHeadings As Variant
    DataHeadings = Array("Level", "Activity", "Description" _
            , "Start", "Finish", "Total Float", "Actual Start", "Actual Finish", "Remain Start", "Forecast Finish" _
            , "Hours, Total", "Hours, Actual", "Hours, Remain", "Hours, Earned" _
            , "Non-Labor, Total", "Non-Labor, Actual", "Non-Labor, Remain" _
            , "Cost, Total", "Cost, Actual", "Cost, Remain")
   
    Dim myDataTemp As Variant
    myDataTemp = QueryResultArray(strsql)
    Erase myData
    ReDim Preserve myData(UBound(myDataTemp) + 1, 20)
    For i = 1 To 20
        myData(1, i) = DataHeadings(i)
    Next i
    For i = 1 To UBound(myDataTemp)
        For j = 1 To 10
            myData(i + 1, j) = myDataTemp(i, 2 + j)
        Next j
        For j = 1 To 3
            myData(i + 1, 10 + j) = myDataTemp(i, 13 + j)
        Next j
        myData(i + 1, 14) = myDataTemp(i, 19)
        For j = 1 To 3
            myData(i + 1, 14 + j) = myDataTemp(i, 19 + j)
        Next j
        For j = 1 To 3
            myData(i + 1, 17 + j) = myDataTemp(i, 23 + j)
        Next j
    Next i
    Erase myDataTemp

Populate a data table worksheet "myTask"

    
'***********************************************************
'6. Populate a data table worksheet "myTask"
'**********************************************************
    Call DeleteWorksheet("myTask")
    
    On Error Resume Next
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("P6 Data")
	if err=0 then
	else
        Set ws = wb.Worksheets.Add(After:=Worksheets("P6 Summary"))
        ws.Name = "P6 Data"
    End If
    On Error GoTo 0
    ws.Activate
    With ws
        .Cells.Clear
        .Cells.Borders.LineStyle = xlNone
        .Columns.ColumnWidth = 5
        .Cells.Interior.Color = RGB(255, 255, 255)
        .Cells.Font.Bold = False
    End With
    r = 1: c = 1: rs = UBound(myData): cs = 20
    ws.Cells(r, c).Resize(rs, cs).Value = myData
    Call Tableformat_Data(ws.Name, r, c, rs, cs)
    With ws
        .Cells(1, 1).Resize(1, 20).EntireColumn.HorizontalAlignment = xlCenter
        .Cells(1, 4).Resize(1, 7).EntireColumn.NumberFormat = Dateformat
        .Cells(1, 6).EntireColumn.NumberFormat = "0"
        .Cells(1, 11).Resize(1, 10).EntireColumn.NumberFormat = "#,##0.00"
        If .Cells(1, 2).EntireColumn.ColumnWidth > 30 Then
            .Cells(1, 2).EntireColumn.ColumnWidth = 30
        End If
        If .Cells(1, 3).EntireColumn.ColumnWidth > 45 Then
            .Cells(1, 3).EntireColumn.ColumnWidth = 45
        End If
        .Cells(1, 2).Resize(1, 2).EntireColumn.HorizontalAlignment = xlLeft
        .Cells(1, 2).Resize(1, 2).HorizontalAlignment = xlCenter
    End With
    For i = 2 To UBound(myData)
        If myData(i, 1) > 0 Then
            Select Case myData(i, 1)
                Case 1
                   With ws.Cells(i, 1).Resize(1, 20)
                        .Interior.ColorIndex = 8
                        .Font.Bold = True
                    End With
                Case 2
                    With ws.Cells(i, 1).Resize(1, 20)
                        .Interior.ColorIndex = 18
                        .Font.Bold = True
                    End With
                Case 3
                    With ws.Cells(i, 1).Resize(1, 20)
                        .Interior.ColorIndex = 33
                        .Font.Bold = True
                    End With
                Case 4
                    With ws.Cells(i, 1).Resize(1, 20)
                        .Interior.ColorIndex = 46
                        .Font.Bold = True
                    End With
                Case 5
                    With ws.Cells(i, 1).Resize(1, 20)
                        .Interior.ColorIndex = 54
                        .Font.Bold = True
                    End With
            End Select
        End If
    Next i
    Application.StatusBar = False
End Sub

3. Data Processing using SQL Connection

Data processing requires mutiple data tables and thus data processing with VBA programming language (array, looping and so on) requires extensive coding effort. SQL can make the coding work much simpler using SQL Connection for Excel VBA than VBA programming.
This is possible by using the ADO connect to Excel driver or Access Database. The current ADO connect is based on the ADO connect to Access Database and late binding to the needed object libraries.

Sql query string is passed to the Function QueryResultArray() below to handle the SQL query like Microsoft Access or SQL server.

Sub ExampleSQL()
'An Example SQL Query as a stirng
	strsql = "SELECT Sum([act_work_qty]) FROM [TASK$] where cstr([proj_id]) = " & ProjectID & ""
    dAct_work_qty = QueryResultArray(strsql)
    dAct_work_qty = Format(dAct_work_qty(1, 1), "#,##0.00")
End Sub
Function QueryResultArray(sqlquery As String) As Variant '4. Microsoft.ACE.OLEDB-Late Binding
    Dim rst As Object
    Dim MyConnect As String
    Dim arrResults() As Variant, i As Long, n As Long
    
    DoEvents
    Set rst = CreateObject("ADODB.Recordset")
    MyConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source=" & ActiveWorkbook.FullName & ";" & _
               "Extended Properties=Excel 12.0"
    With rst
        .Open sqlquery, MyConnect
        .MoveFirst
        n = 0
        Do Until .EOF
             n = n + 1
             .MoveNext
        Loop
        Erase arrResults
        ReDim Preserve arrResults(n, .Fields.Count)

       .MoveFirst
        n = 0
        Do Until .EOF
            n = n + 1
            For i = 1 To .Fields.Count
                On Error Resume Next
                arrResults(n, i) = .Fields(i - 1)
                On Error GoTo 0
            Next i
            .MoveNext
        Loop
    End With
    QueryResultArray = arrResults
    Set rst = Nothing
    MyConnect = ""
End Function

4. Project planning data using the Xer file

On top of this page, the following pages can help you read/parse Xer file to Excel, consolidate project data and create project calendar and to do so, visit the pages below.

Xer (P6 text file) written to Excel P6-project summary based on p6 xer file
P6-project calendar based on p6 xer file

5. Download an application package designed for Xer data manipulation

The downloadable application covers four(4) pages:Read/parse Xer data, P6 summary, P6 data table, and P6 Calendar.

Download Excel add-in and a workbook for demonstration

6. Loading Excel Add-in

It is necessary to install the downloaded Excel Add-in. To do so, visit the page below.

Create and load Excel Add-in

Modified on:3-November-2019
Dated on: 4-October-2019