CODEWITHSUNDEEP
vbams-project
Pear Kavisara
Pear Kavisara

Reputation: 47

Add resource automatically by task name in MS-project

I want to automatically add resource name just for some task (sub-task) in MS-project for example if task is CMM i want automatically add CMM to resource name And this is my code

Sub Automatically()
Dim NR As MsProject.Resource
Dim Tsk As MsProject.Task
Dim Row As Integer
For each row in Ms.Project.Task
          If Tsk = "CMM" Or "EDM" Or "EL Milling" Or "CAM Wire cut" Or "Laser Welding" Or "Wire cut" Or "CNC Milling" Or "Grinding" Or "Lathe" Or "Manual Milling" Or "Polishing"
               Set NR = NR.Resource.Add.Tsk
          End If
          If Tsk = "Inspection" Or "Report" Then
               Set NR =  "CMM"
          End if
Next row
End Sub

Upvotes: 1

Views: 1073

Answers (1)

Rachel Hettinger
Rachel Hettinger

Reputation: 8442

This code assigns resources to tasks based on the names of the tasks. Given that task names are typically more descriptive than a single word, the code uses a contains search (e.g. Like). If the resource does not already exist, it is added.

Sub AddResourceAssignments()

    Dim resName As String

    Dim tsk As Task
    For Each tsk In ActiveProject.Tasks
        ' determine the resource to add to the task
        Select Case True
            Case (tsk.Name Like "*Gate*"): resName = "Gate"
            Case (tsk.Name Like "*CMM*"): resName = "CMM"
            Case (tsk.Name Like "*EDM*"): resName = "EDM"
            Case (tsk.Name Like "*EL Milling*"): resName = "EL Milling"
            Case (tsk.Name Like "*CAM Wire cut*"): resName = "CAM Wire cut"
            Case (tsk.Name Like "*Laser Welding*"): resName = "Laser Welding"
            Case (tsk.Name Like "*Wire cut*"): resName = "Wire cut"
            Case (tsk.Name Like "*CNC Milling*"): resName = "CNC Milling"
            Case (tsk.Name Like "*Grinding*"): resName = "Grinding"
            Case (tsk.Name Like "*Lathe*"): resName = "Lathe"
            Case (tsk.Name Like "*Manual Milling*"): resName = "Manual Milling"
            Case (tsk.Name Like "*Polishing*"): resName = "Polishing"
            Case (tsk.Name Like "*Inspection*"): resName = "CMM"
            Case (tsk.Name Like "*Report*"): resName = "CMM"
            Case Else: resName = vbNullString
        End Select

        If Len(resName) > 0 Then
            ' create the resource assignment
            On Error Resume Next
            Dim res As Resource
            Set res = ActiveProject.Resources(resName)
            If Err.Number <> 0 Then
                ' presume error due to missing resource
                Set res = ActiveProject.Resources.Add(Name:=resName)
            End If
            tsk.Assignments.Add ResourceID:=res.ID
        End If

    Next tsk

End Sub

Upvotes: 1

Related Questions