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.
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.
- Schedule data: Activity Start, Finish, Actual Start, Actual Finish, Remain Start, Remain Finish
- Labor in hours: Budget, Actual, Earned Value, Remaining
- Non-labor in hours: Budget, Actual, Remaining
- Projct cost: Budget, Actual, Remaining
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 fileP6-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 demonstration6. 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