we are just starting to investigate MS Project Online - Enterprise. I use a couple of VBA scripts in the standard version of MS Project, just can't figure out if its possible to add exceptions using VBA into the Enterprise Calendar. I want to populate at least 10 years worth of public holidays and would rather not manually doing it.
thanks in advance
My existing scripts for adding exceptions are below:
Sub Create_Resource_Exceptions() 'used for resources
Dim e As Exception
Dim cal As Calendar
Dim CalName As String
CalName = ActiveProject.Calendar.name
ActiveProject.Resources("TempPublicHolidays").Calendar.Exceptions.Add Type:=1, Start:="1/01/2020", Finish:="1/01/2020", name:="New Year's Day"
'copy above to insert more public holidays
End Sub
and
Sub Create_New_Exceptions() ' Used for the base calendar
Dim e As Exception
Dim cal As Calendar
Dim CalName As String
CalName = ActiveProject.Calendar.Name
ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1, Start:="1/01/2020", Finish:="1/01/2020", Name:="New Year's Day" ActiveProject.BaseCalendars(CalName).Exceptions.Add Type:=1,
End Sub
Related
I am simply trying to add Actual Work Hours data per day for each Task and Resource?
How can I write a hours on actual work column (For example X task R Resource on 07.02.21 he work 4 hours and on 07.03.21 he work 3 hours how can I add these data using vba macros to MS Project)
Example:
Dim tsk as Task
Dim finder as string
dim names as string
for each tsk in activeproject.tasks
if instr(tsk.text1, "TASK CODE" )> 0 then
finder= tsk.text1
if instr(tsk.ResourceNames, "Name")>0 then
' Implement the actual data codes here
endif
endif
next tsk
To sum up
How can I add the data on Actualk Work to spesific people in spesific task.
The method needed is TimeScaleData. Here's an example of how to use it to set actual work hours for 7/2 and 7/3, at the resource assignment level:
Sub SetActualHours()
Dim tsk As Task
Dim names As String
For Each tsk In ActiveProject.Tasks
If InStr(tsk.Text1, "TASK CODE") > 0 Then
Dim asn As Assignment
For Each asn In tsk.Assignments
If asn.Resource.Name = "Name" Then
Dim tsv As TimeScaleValues
Set tsv = asn.TimeScaleData(StartDate:=#7/2/2021#, EndDate:=#7/4/2021# _
, Type:=pjAssignmentTimescaledActualWork, TimeScaleUnit:=pjTimescaleDays)
tsv(1).Value = 4 * 60
tsv(2).Value = 3 * 60
End If
Next asn
End If
Next tsk
End Sub
I am trying to simplify a process for field employees at my work. The baseline case is that the employees fill out Daily Detail Reports in a single Excel Workbook throughout the year with the hours they have worked that day, the project # and Phase Code their labor costs will hit and the hours that they worked that day on that particular project. It is very common for the same project number and phase code to be used more than once for a single day (i.e. multiple row entries which will need the total hours added together based on the condition of having the same project number and phase code for that day). See attached "Detail Report WB" image.
Our employees then have to enter the same data in a different format (i.e. only one line allowed per project number and phase code pair per day) in a separate workbook. See attached "Timesheet Import WB" image. The timesheet workbook is driven based on the week end date for that week (i.e. Sunday). The Daily Detail Report workbook however, is driven based on the week beginning date and Sundays are not included in the Daily Detail Report. To make things more complicated, the dates listed in the Daily Detail report are based on formulas and do not house the actual date value in the cells.
The goal of this solution is to take the information entered into the Daily Detail Report workbook and place it into the Timesheet workbook via a sub function based on a ActiveX command button click event. See the attached “End Goal” image.
So far I have compiled the following code to allow the user to click the import button which prompts the user to find the Daily Detail Report workbook that they would like to import data from. This code also allows for the user to input the week end date desired for the Timesheet workbook. I was trying to use the week end date to find the desired data in the Daily Detail Report workbook, but this is proving difficult. Any assistance would be greatly appreciated. It’s been years since I took into to computer programming in VBA back in college.
Images are located here: https://drive.google.com/drive/folders/0B7BjXxM59FFyQlM5eThvc0dDWUU?usp=sharing
Thanks!
Private Sub CommandButton1_Click()
'Define All Variables
Dim GCell As Range
Dim fDialog As FileDialog, result As Integer
Dim MyDetailReport As String
Dim MyTimeSheet As String
Dim MySheet As String
Dim ProjNum As String
Dim PhaseCode As String
Dim Hours As String
Dim WkEndDate As String
'Find source file
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
fDialog.AllowMultiSelect = False
fDialog.Title = "Select Daily Report File to Import"
fDialog.InitialFileName = "W:\PDX - Mechanical Construction\Operations\Detailing\Daily Tracking Logs\"
fDialog.Filters.Clear
fDialog.Filters.Add "Excel files", "*.xlsx"
If fDialog.Show = -1 Then
MyDetailReport = fDialog.SelectedItems(1)
End If
'Enter date to look for in workbook
WkEndDate = InputBox("Insert Week End Date in format mm/dd/yyyy", "User date", Format(Now(), "mm/dd/yyyy"))
If IsDate(WkEndDate) Then
WkEndDate = Format(CDate(WkEndDate), "mm/dd/yyyy")
'Place Week End Date into Timesheet workbook
With ThisWorkbook.ActiveSheet.Range("AE5")
.Value = WkEndDate
End With
Else
MsgBox "Wrong date format"
End If
'Use the current sheet to store found data
MySheet = ActiveSheet.Name
'Use Error Handling routine in case of errors
On Error GoTo ErrorHandler
'Turn off screen updating to run macro faster
Application.ScreenUpdating = False
Workbooks.Open Filename:=MyDetailReport & MyTimeSheet
'Search Detail Report "Daily Report Log" sheet for the selected Week End Date
Set GCell = ActiveSheet.Cells.Find(WkEndDate, LookIn:=xlValues)
GCell = GCell.Offset(2, 1)
If GCell.Value = "" Then
GCell = GCell.Offset(1, 0)
Else
'copy data formulas to correct format for Timesheet workbook
End If
'Error Handling
ErrorHandler:
Select Case Err.Number
'Common error #2: the specified data wasn't in the target workbook.
Case 9, 91
Application.ScreenUpdating = True
MsgBox "The value " & WkEndDate & " was not found."
Exit Sub
'General case: turn screenupdating back on, and exit.
Case Else
Application.ScreenUpdating = True
Exit Sub
End Select
End Sub
I'm using the BaselineWork1 timescaledata to contain a time phased calculation of resource work on individual tasks that I perform on a weekly basis. I want to zero out the previous week's calculation before I populate it with this week's calculation. Short of creating a loop to write zeros to the timescale data for each resource on each task is there a way to do this more efficiently? Could I make the beginning date and end date equal to the project's start and end date and time scale = seconds and the value to write equal to zero? For instance:
For lngCnt1 = 1 To tskCounter.Resources.Count
tskCounter.Assignments.Item(lngCnt1).TimeScaleData(StartDate:=ActiveProject.ProjectStart, EndDate:=ActiveProject.ProjectFinish, _
Type:=pjAssignmentTimescaledBaseline1Work, _
timescalunit:=pjTimescaleMinutes, Count:=1).Item(1).Value = 0
Next lngCnt1
This doesn't seem to work as it only zeros out the baseline1 work field for the date corresponding to the project start date.
To clear time-scaled work from anything but the forecast work field, you do need to loop through every assignment on every task. However, when it comes to the individual time-scale values, you can lump these together by year to reduce the iterations required.
Sub ClearBaseline1Work()
Dim projStart As Date
Dim projEnd As Date
projStart = ActiveProject.ProjectStart
projEnd = ActiveProject.ProjectFinish
Dim tsk As Task
For Each tsk In ActiveProject.Tasks
Dim asn As Assignment
For Each asn In tsk.Assignments
Dim TSValues As TimeScaleValues
Set TSValues = asn.TimeScaleData(projStart, projEnd, pjAssignmentTimescaledBaseline1Work, pjTimescaleYears)
Dim tsv As TimeScaleValue
For Each tsv In TSValues
tsv.Clear
Next tsv
asn.Baseline1Work = 0
Next asn
tsk.Baseline1Work = 0
Next tsk
End Sub
Remember that Baseline1 work values are not automatically updated at the assignment or task level; those values need to be explicitly cleared.
I am trying to pull all data entries that are within a userform selected month and year. I can get the code to run fine when I hard code the year but I want the year to come off of a text box. I converted the Textbox value to an integer using Cint() and dim'd it to "Year" in my if statement. I can get it to work if I write Cdate("3/1/2016"), but I want see if there is a way to run it like: Cdate("3/1/Year"). I tried it this way and get a typematch error on the Cdate Im pretty new to VBA so excuse my stupidity.
Ignore the "Month" variable I was just using that to put a stop on the code and step it through to see if it would enter my if statement.
Thanks in advance.
My Code
Private Sub OKBtn_Click()
Dim Sales As Range
Dim Year As Integer
Dim Month As Integer
Dim i As Integer
Year = CInt(YearText.Value)
Set Sales = Worksheets("Sales").Range("A4")
i = 0
If Sales.Offset(i, 1).Value >= CDate("3/1/2016") And Sales.Offset(i, 1).Value <= CDate(" 3/31/2016 ") Then
Month = 1
End If
In order for the CDate to work, you need to seperate the stings inside the brackets to 2 parts
1.The constant, in your case "3/1/".
2.And the variable, CInt(YearText.Value).
Option Explicit
Private Sub OKBtn_Click()
Dim DDate As Date
DDate = CDate("3/1/" & CInt(YearText.Value))
' for debug only
MsgBox "Date entered is :" & DDate
End Sub
I need your help in creating the macro in an Excel file that clears all the values in the sheet which is called "Sheet1" after four days from today's date, which is "2-Jun-2015", and to save it. So once the user opens the Excel file on the fifth day, the sheet will be blank.
The code for clearing the data is:
Sheet1.Cells.Clear
But my issue is how to clear the data after four days and to save the changes with the user unable to see any data in the fifth day.
This will work for you. DateDiff is a great function that would return the difference between two dates in a unit of your choice (years, months, days, hours ...), also you FileDateTime to get date of the file
Sub Workbook_Open()
If DateDiff("d", FileDateTime(ThisWorkbook.FullName), Now) >= 4 Then
Sheet1.Cells.Clear
ThisWorkbook.Save
End If
End Sub
I haven't had the chance to test it yet, but might I suggest something like this:
Private Sub Workbook_Open()
Dim currDate As String, closeDate As String, fileDate As String
Dim oFS As Object, sFile As String
currDate = Date
closeDate = Date(Year(currDate); Month(currDate); Day(currDate)-4)
sFile = Application.ActiveWorkbook.Fullname
Set oFS = CreateObject("Scripting.FileSystemObject")
fileDate = oFS.GetFile(sFile).Datelastmodified
If fileDate <= closeDate Then
' Change argument passed to Sheets to whatever sheet you want to kill off
ActiveWorkbook.Sheets(1)Cells.Clear
End If
End Sub
Borrowed some code from here: https://stackoverflow.com/a/10823572/4604845