Im new to VBA, and looking for a simple code to copy say, my current finish and start dates to finish1 and start1
So I can track a shift trend
Here is a simple procedure that loops through the tasks in the active schedule and copies the start/finish dates into start1/finish1.
Sub CopyDates()
Dim t As Task
For Each t In ActiveProject.Tasks
t.Start1 = t.Start
t.Finish1 = t.Finish
Next t
End Sub
In addition to the method Rachel provided, you can use the BaselineSave method of the MS Project Application object. Even though it's called BaselineSave, the method has optional arguments that will allow you to copy current dates into any of the start/finish fields without setting the actual baseline of the tasks. I prefer this method since it can accomplished in a single line.
Sub CopyDates()
Application.BaselineSave All:=True, Copy:=pjCopyCurrent, Into:=pjIntoStart_Finish1
End Sub
Related
I have been wracking my brain trying to work out how to write a small piece of code that will activate only when particular fields at a task level have been modified.
I tried to make this code work at the project change level with a for each loop and select cases but that lags the whole program and still doesn't give me the result I need. I also tried to make it work when run manually with a for each loop and select cases or a bunch of If statements, but again, it can't tell me which field changed, but it can highlight a discrepancy between two fields.
The goal is to have a change log field (Text10) that auto updates based on the field that is modified and the date of the change. I only care about 4 fields changing (Date1, Date2, Date3, Date4).
e.g. If [Date1] is modified, Text10 = "Date1 modified 10/11/21"
Note: If 2 fields are modified, I would be happy enough with just listing the last one.
I was hoping there was some sort of "On Change, If Target = xxx" but I have not been able to find anything like that.
I also tried implementing the code as defined here >> Microsoft Documents: Project.Change Event but I am unclear what this is supposed to do and couldn't actually see it doing anything / I never got the message box I believe was supposed to appear.
I am using Microsoft Project Standard 2019.
After much research and trial and error, I ended up solving this.
To get it working, I added a Class Module and ran a piece of code on open to initialize it. This essentially tells Project to start watching for events. I then use the "Field" variant to fill the field name amongst the text string and "NewVal" variant to fill the result. This was an easy solution in the end. The code I found that worked is below:
In Class Module "cm_Events"
Public WithEvents MyMSPApp As MSProject.Application
Private Sub Class_Initialize()
Set MyMSPApp = Application
End Sub
Private Sub MyMSPApp_ProjectBeforeTaskChange(ByVal tsk As Task, ByVal Field As PjField, ByVal NewVal As Variant, Cancel As Boolean)
'What you want the code to do
End Sub
In Module "m_Events"
Public oMSPEvents As New cm_Events
Sub StartEvents()
Set oMSPEvents.MyMSPApp = MSProject.Application
End Sub
In ThisProject code
Private Sub Project_Open(ByVal pj As Project)
Call m_Events.StartEvents
End Sub
I need to programmatically make changes to a few tasks. The tasks that need changes have ID numbers in the Text10 field. I would like to avoid using a filter if possible since all of these ID numbers are different. And looping through all the tasks takes way too long since the project file is 10k+ lines. I'm not sure if "Find" is the correct method here.
Question:
Is there a way to find the task using Text10 and assign is to a "Task" object so that I can then manipulate it?
The below doesn't work but can hopefully get the point across:
Sub test()
Dim t As Task
Set t = Find("Text10", "equals", "A1044Fh82")
t.SetField pjTaskDuration, 0
End Sub
Thanks!
The Find method returns True if a matching value is found, and if so, the active selection is moved to the first matching task. So check the result of the Find method and then use the ActiveCell property to get a reference to the task:
If Application.Find("Text10", "equals", "A1044Fh82") Then
Dim t As Task
Set t = Application.ActiveCell.Task
t.Duration = 0
End If
I've created several custom functions which I would like to Register. Currently, I have a different procedure for which I specify the registration for each function (there's no issue with that piece). However, the only way I know of to registering all these functions is by calling each Macro by name in another procedure like this:
Sub spRegisterFunctions()
Call spRegisterCUSTOMAfunction
Call spRegisterCUSTOMBfunction
Call spRegisterCUSTOMCfunction
Call spRegisterCUSTOMDfunction
End Sub
I'm actually looking for something more dynamic so that every time I create a new function, and it's corresponding "spRegister..." procedure, I don't have to remember to add the "Call" code to the "Sub spRegisterFunction()" procedure for that specific function.
Here's an example of what attempting to do:
Sub spRegisterFunctions()
Dim mc as Macro
For Each mc in VBProject("NameOfProject").Module("NameOfModule")
If Left(mc.Name,10)="spRegister" then
Call mc
End If
Next mc
End Sub
As you can see, I'm attempting to run any macro in a specific module who's name begins with "spRegister". Obviously the code above will not work, partly because some of those objects don't even exist.
Is there any way to do this?
I am currently trying to write a VBA code that will look at a project plan and delete all of the tasks that have zero work effort, but are not a milestone, from my plan. We have added a custom field called Key Milestone to capture whether a task is a milestone or not. The reason we are not using the existing Milestone field is that not all of the tasks with zero work effort and zero duration are necessarily milestones.
I was previously unfamiliar with the GetField function in VBA and I have been working through a couple of tries at incorporating this to 'read' the custom field as a part of this code. Here is what I have so far:
Sub DeleteMsProjectTask()
Dim proj As Project
Dim t As Task
Set proj = ActiveProject
For Each t In proj.Tasks
If t.OutlineLevel > 1 And t.Work = 0 Then
If GetField(FieldNametoFieldConstant("Key Milestone") = Yes Then
Else
t.Delete
End If
End If
Next t
End Sub
This is not working as it doesn't read the milestone field correctly. Thanks in advance for the help!
GetField is a method of the Task object, so you need to preface it with your task object variable, e.g. t.GetField. Also, you missed a closing parentheses. And since GetField returns a string, you need to compare to a string--in other words, the word Yes needed to be in quotes. Since the criteria for deletion was actually a "No" value, I simplified your code accordingly.
Sub DeleteMsProjectTask()
Dim proj As Project
Dim t As Task
Set proj = ActiveProject
For Each t In proj.Tasks
If t.OutlineLevel > 1 And t.Work = 0 Then
If t.GetField(FieldNameToFieldConstant("Key Milestone")) = "No" Then
t.Delete
End If
End If
Next t
End Sub
I want to save an excel at every 2 seconds. Data is updated in this excel through DDE and want to read this data every 2 seconds. Unfortunately this data is not saved on hard disk.
I am aware of macro which can be used to save file after specified point of time but do not want to use macro.
Since data is updated frequently in this sheet through DDE (at every 100 MS) so sheet change event triggers too often.
Below is the code which i am trying but not getting success.
Dim ctme, ptme As Integer
Private Sub Workbook_Open()
ctme = Second(Now)
ptme = ctme - 2
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ctme = Second(Now)
If (ctme - ptme) = 2 Then
Me.Save
ptme = ctme
End If
End Sub
Please help
Nidhi, people here are trying to help you and you need to understand that no one has the access to your brain to understand what you actually meant to ask. So it is quite natural to ask questions to understand the issue clearly before suggesting any answer. The people here, get equally frustrated when they are unable to understand a simple question, the time they spend could have been easily saved, had the person spent a little extra time in explaining the things better. So giving credit to those who are trying to help you, will not harm at all.
Ok, coming back to your question. I may be wrong, but I think that SheetChange event is not fired on DDE update. Please correct me if I am wrong.
The next option can be Application.OnTime functionality.
Write the following code in Workbook Open Method:
Private Sub Workbook_Open()
Dim currentTime As Date
currentTime = DateAdd("s", 2, Now)
Application.OnTime currentTime, "SaveFile"
End Sub
Then Add a new Module and add the following Function there in new Module:
Public Sub SaveFile()
ThisWorkbook.Save
Dim currentTime As Date
currentTime = DateAdd("s", 2, Now)
Application.OnTime currentTime, "SaveFile"
End Sub
The above code will create a timer which would run every two seconds to save your file. There are pros and cons for this approach, but it's Excel's best possible Timer functionality. Let me know if you have any questions.
Thanks,
Vikas
(this is totally away from the OP tags but just thought I'd put forward a possible alternative)
Create a small .NET console application.
User one of the Timer objects available to create this timed loop you require.
Then using a reference to Excel Interop library on each sweep of the loop it looks like you might need to open this workbook, save it, and then close it again .....depending on the calculations within the book and the size of the Excel file is it physically possible on your machine to open/calculate/save within 2 seconds?