MS Project 2013: display resources on summary tasks - ms-project

Is there a way to configure MS Project 2013 so that it displays in a resource column (eg, resource initials) of the Gantt Chart view of summary tasks the UNION of all resources assigned to its leaf subtasks.
Say for example that I have a summary task S with 2 subtasks S1 & S2, S2 being itself divided into subsubtasks S21 & S22.
Say also that I have allocated resources R1,R2 to S1, resources R2,R3 to S21 and resource R4 to S22.
With my current configuration, the resource initial column of both S2 and S are left blank.
Instead, I would like the resource column of S2 to display R2, R3, R4 and the resource column of S to display R1, R2, R3, R4.
The idea is to be able to visualize all the resources allocated to a summary tasks even when its decomposition in subtasks is hidden.
Thank you very in advance for suggestions on how to achieve this.

Those resource fields exist at the summary level because you can directly assign resources to a summary task, so you can't use those fields for this purpose. However, here's a macro that aggregates the names of the resources assigned to the subtasks. The results are put in Text1 at the summary level. You can then modify the Gantt chart bar styles to show that text field.
Sub RollupResourceNames()
Dim tsk As Task
Dim list As String
Dim key As Variant
For Each tsk In ActiveProject.Tasks
If tsk.Summary Then
Dim col As New Collection
Set col = GetChildResourceAssignments(tsk)
list = vbNullString
For Each key In col
list = list & ", " & key
Next
If Len(list) > 2 Then
list = Mid$(list, 3)
End If
tsk.Text1 = list
End If
Next tsk
End Sub
Function GetChildResourceAssignments(parent As Task) As Collection
Dim col As New Collection
Dim child As Task
Dim asn As Assignment
For Each child In parent.OutlineChildren
If child.Summary Then
Dim col2 As New Collection
Set col2 = GetChildResourceAssignments(child)
Dim key As Variant
For Each key In col2
col.Add key, key
Next key
End If
For Each asn In child.Assignments
On Error Resume Next
col.Add asn.Resource.Name, asn.Resource.Name
On Error GoTo 0
Next asn
Next child
Set GetChildResourceAssignments = col
End Function

#Rachel Hettinger - Solution works great, except it will error out (error 457) if you have multiple levels of parent/child tasks and the same resource is present across different levels. It tries to add the resource name to the collection, but it already exists (since it was added earlier when the script checked the other set of tasks) and doesn't know what to do.
This is fixable by simply adding another "On Error Resume Next" line. Here is the revised macro, which works perfectly on my Project Plan. All credit to Rachel Hettinger here, I just added one line!
Sub RollupResourceNames()
Dim tsk As Task
Dim list As String
Dim key As Variant
For Each tsk In ActiveProject.Tasks
If tsk.Summary Then
Dim col As New Collection
Set col = GetChildResourceAssignments(tsk)
list = vbNullString
For Each key In col
list = list & ", " & key
Next
If Len(list) > 2 Then
list = Mid$(list, 3)
End If
tsk.Text1 = list
End If
Next tsk
End Sub
Function GetChildResourceAssignments(parent As Task) As Collection
Dim col As New Collection
Dim child As Task
Dim asn As Assignment
For Each child In parent.OutlineChildren
If child.Summary Then
Dim col2 As New Collection
Set col2 = GetChildResourceAssignments(child)
Dim key As Variant
For Each key In col2
On Error Resume Next
col.Add key, key
Next key
End If
For Each asn In child.Assignments
On Error Resume Next
col.Add asn.Resource.Name, asn.Resource.Name
On Error GoTo 0
Next asn
Next child
Set GetChildResourceAssignments = col
End Function

Related

How can I compare a text box entry against a list of database values in the Text_Changed event

as the title states I am trying to compare or validate a text box entry against a list of acceptable values stored in my database. As of now I have taken the values from my database and store them in a List(of String) and I have a for loop that loops through that list and returns true if the values match, if the values do not match it will return false. Below I have attached the code I am currently working with.
Protected Sub txtSearchOC_TextChanged(sender As Object, e As EventArgs) Handles txtSearchOC.TextChanged
Dim listEType As List(Of String) = New List(Of String)
Dim eType As String = txtSearchOC.Text
Dim strResult As String = ""
lblPrefix.Text = ""
lblList.Text = ""
Dim TypeIDQuery As String = "
SELECT a.OrderCode
FROM SKU AS a
INNER JOIN EnrollmentType AS e ON a.EnrollmentTypeID = e.TypeID
INNER JOIN Enrollment AS f ON e.RecID = f.EnrollmentTypeID
WHERE f.AccountNumber = '12345';
"
Using connEType As New SqlConnection(ConfigurationManager.ConnectionStrings("WarrantyConnectionString").ToString)
Using cmdEType As New SqlCommand(TypeIDQuery, connEType)
cmdEType.Parameters.Add("#AccountNumber", SqlDbType.VarChar, 15).Value = "12345"
connEType.Open()
Using sdrEType As SqlDataReader = cmdEType.ExecuteReader
While sdrEType.Read
listEType.Add(sdrEType("OrderCode").ToString)
End While
End Using
End Using
End Using
For Each Item As String In listEType
strResult &= Item & ", "
Next
For i = 0 To listEType.Count - 1
If eType = listEType(i) Then
lblPrefix.Text = "True"
End If
If eType <> listEType(i) Then
lblList.Text = "Error"
End If
Next
'lblList.Text = strResult
End Sub
In the code I declare my list and a variable to store the text value of the text box. To verify that it pulled the appropriate values from the database I have the strResult variable and can confirm that the appropriate values are being stored.
The problem I am having has to do with the For loop I have at the bottom, when I enter in a valid value that is contained in the listEType, I get the confirmation message of "True" indicating it has matched with one of the values, but I also get the "Error" message indicating that it does not match. If I enter in a value that is not contained in the list I only get the "Error" message which is supposed to happen.
My question is, based on the code I have supplied, why would that For loop be returning both "True" and "Error" at the same time for a valid entry? Also, if there is a better way to accomplish what I am trying to do, I am all ears so to speak as I am relatively new to programming.
Well, as others suggested, a drop down (combo box) would be better.
However, lets assume for some reason you don't want a combo box.
I would not loop the data. You have this amazing database engine, and it can do all the work - and no need to loop the data for such a operation. Why not query the database, and check for the value?
Say like this:
Protected Sub txtSearchOC_TextChanged(sender As Object, e As EventArgs) Handles txtSearchOC.TextChanged
If txtSearchOC.Text <> "" Then
Dim TypeIDQuery As String = "
SELECT a.OrderCode FROM SKU AS a
INNER JOIN EnrollmentType AS e ON a.EnrollmentTypeID = e.TypeID
INNER JOIN Enrollment AS f ON e.RecID = f.EnrollmentTypeID
WHERE f.AccountNumber = #AccoutNumber;"
Using connEType As New SqlConnection(ConfigurationManager.ConnectionStrings("WarrantyConnectionString").ToString)
Using cmdEType As New SqlCommand(TypeIDQuery, connEType)
cmdEType.Parameters.Add("#AccountNumber", SqlDbType.NVarChar).Value = txtSearchOC.Text
connEType.Open()
Dim rstData As New DataTable
rstData.Load(cmdEType.ExecuteReader)
If rstData.Rows.Count > 0 Then
' we have a valid match
lblPrefix.Text = "True"
Else
' we do not have a valid match
lblPrefix.Text = "False"
End If
End Using
End Using
End If
End Sub
So, pull the data into a data table. You can then check the row count, or even pull other values out of that one row. But, I don't see any need for some loop here.

Sheridan SSDB Grid set value for entire column

I'm not sure if what I'm trying to do here is possible. I've got a Sheridan SSDB Grid, which is bound to a data control. When I populate the data control, the grid gets filled.
However, I've had to manually add an additional column after populating the grid to display a value which isn't in a database table.
To do all of this, I've written this code:
Dim SQL As String
SQL = My_Query
dtaEmployees.DatabaseName = DB_Period_Name$
dtaEmployees.RecordSource = SQL
dtaEmployees.Refresh
dtaEmployees.Recordset.MoveFirst
grdEmployees.Redraw = True
grdEmployees.Columns.Add (4)
I'm not sure how I can fill this new column in, however. I've got a global variable storing the value that I need, but none of the following lines of code are working
grdEmployees.Columns(4).Value = My_Variable
grdEmployees.Columns(4).Text = My_Variable
How can I set the value for all of the rows in the grid?
EDIT
After following the suggestion in the comments, I've modified my code as follows.
Form load:
Dim dbsPeriod As Database
Dim tdfEmployees As TableDef
Dim fldLoop As Field
Set dbsPeriod = OpenDatabase(DB_Period_Name$)
Set tdfEmployees = dbsPeriod.TableDefs!Ledger
AppendDeleteField tdfEmployees, "APPEND", "Location", dbText, 8
grdEmployees.DataSource = tdfEmployees
AppendDeleteField tdfEmployees, "DELETE", "Location"
dbsPeriod.Close
AppendDeleteField sub:
Private Sub AppendDeleteField(tdfTemp As TableDef, strCommand As String, _
strName As String, _
Optional varType, Optional varSize)
With tdfTemp
If .Updatable = False Then
MsgBox "Failed to initialise grid!"
Exit Sub
End If
If strCommand = "APPEND" Then
.Fields.Append .CreateField(strName, varType, varSize)
Else
If strCommand = "DELETE" Then .Fields.Delete strName
End If
End With
End Sub
With this code, no data is loaded into the grid at all.
You're not loading the data into the RecordSet before you delete the field. You need to get the data (using your SELECT query) into a data structure which the grid can use as the .DataSource
A TableDef is not a data structure, it just allows you to make changes to the database table itself, which is why your code isn't returning any rows.

ASP VB NET List(of T) find method failing in a for each loop

Good morning stackers!
I'm designing a massive update page. Here are the general steps:
I have a class called item which has two properties: Equipment number and new due date.
I have a textbox where i paste values from Excel, the values consist of two columns divided by a vbtab character: the columns are an equipment number and a new due date
A button is clicked and the values from textbox are parsed into a list(of item) and the equipment master builds a string for an SQL criteria for a commandtext.
The command fills a dataset from a database which gets equipment number and current due date.
I add manually a column to the dataset (new due date)
I iterate over the rows of the dataset, and i use the list(of item) find method matching equipment from the list and from the database to get a new due date from the textbox parsed values.
Everything is going well, except that when using the find method for more than 1 row in the dataset, the method fails:
Here is the code from point 5 and 6:
da.Fill(ds, "Equipments")
dt = ds.Tables(0)
ds.Tables(0).Columns.Add("column_1", Type.GetType("System.DateTime"))
Dim rw As DataRow
For Each rw In ds.Tables(0).Rows
Dim strsearch As String = rw(0).ToString
Dim fequnumb As item = myItemList.Find(Function(p) p.EquipNumber = strsearch)
rw(2) = fequnumb.DueDate <- Error occurs here
Next
Again, if instead of ftechid.DueDate I put a static value like Today()the code runs fine for the loop and fills correctly the gridview, but if i leave the ftechid.DueDate then an error is thrown after the first row:
Object reference not set to an instance of an object.
Any help is very much appreciated as to how to use the find method inside a for..each loop
If the Find function cannot match the string requested it returns Nothing and then you cannot set the due date from a variable that is Nothing. If this is a condition expected from the input then you need to protect the assignment to the new column with something like this.
For Each rw In ds.Tables(0).Rows
Dim strsearch As String = rw(0).ToString
Dim fequnumb As item = myItemList.FirstOrDefault(Function(p) p.EquipNumber = strsearch)
if fequnumb IsNot Nothing Then
rw(2) = fequnumb.DueDate <- Error occurs here
End if
Next
If this is not supposed to happen then you need to check your inputs

How to improve the performance of this function?

This function takes around 1.2 seconds to execute. I am unable to understand why? Is it because of the inner joins? If yes, then how can i improve the execution speed? I am using Microsoft Enterprise Library.
Public Shared Function GetDataByInterests(ByVal accountId As Integer) As Object
Dim details As New List(Of GetIdBasedOnInterest)()
Dim getIDs As New GetIdBasedOnInterest
Dim interests As String = ""
Dim db As SqlDatabase = Connection.Connection
Using cmdGeneric As DbCommand = db.GetSqlStringCommand("SELECT Interests.InterestName FROM UserInterests INNER JOIN Interests ON UserInterests.InterestID = Interests.InterestID WHERE UserInterests.AccountID=#AccountID")
db.AddInParameter(cmdGeneric, "AccountID", SqlDbType.Int, accountId)
Dim dsInterests As DataSet = db.ExecuteDataSet(cmdGeneric)
For i = 0 To dsInterests.Tables(0).Rows.Count - 1
If i = dsInterests.Tables(0).Rows.Count - 1 Then
interests = interests & dsInterests.Tables(0).Rows(i).Item(0).ToString
Else
interests = interests & dsInterests.Tables(0).Rows(i).Item(0).ToString & ","
End If
Next
End Using
getIDs.InterestName = interests
details.Add(getIDs)
Return details
End Function
Without knowing anything of the underlying tables and their indexes (and this is a check you should do immediately) there is an obvious problem in your loop.
You cancatenate strings, this, potentially could pose a strong pressure on the memory used by your program.
A string concatenation results in a new string allocated on the memory and thus, if your table contains many rows, the effect could be noticeable.
You could try to use a StringBuilder
Dim interests As new StringBuilder(1024) ' suppose an internal buffer of 1K'
...
If i = dsInterests.Tables(0).Rows.Count - 1 Then
interests.Append(dsInterests.Tables(0).Rows(i).Item(0).ToString)
Else
interests.Append(dsInterests.Tables(0).Rows(i).Item(0).ToString & ",")
End If
....
getIDs.InterestName = interests.ToString
Of course this optimization could be absolutely not important if your tables (UserInterests and Interests) are not correctly indexed on the fields InterestID and AccountID
EDIT: Another micro-optimization is to remove the internal IF test and truncate the resulting output only after the loop ends
For ....
interests.Append(dsInterests.Tables(0).Rows(i).Item(0).ToString & ",")
Next
if(interest.Length > 0) interest.Length -= 1;
EDIT As for your request, this is an example to create an unique index. The syntax could be more complex and varying depending on the Sql Server version, but basically you do this in Sql Management Studio
CREATE UNIQUE INDEX <indexname> ON <tablename>
(
<columntobeindexed>
)
Check the CREATE INDEX statement examples on MSDN
1) Time your query in SQL Server Management studio. It will be much easier to tune it there in isolation from your VB code. Also you can run the display the query plan, and it ight even suggest new indexes.
2) Check you have the relevent primary keys and indexes defined.
3) Pull common expressions out of your for loop, to avoid recomputing the same thing over and over:
4) Like Steve says, use a StringBuilder
Combining those points:
Dim theTable as ...
Dim rowCount as Integer
Dim interests As new StringBuilder(1024)
Set theTable = dsInterests.Tables(0)
rowCount = theTable.Rows.Count
For i = 0 To rowCount - 1
interests.Append(theTable.Rows(i).Item(0).ToString)
If i <> rowCount - 1 Then
interests.Append(",")
End If
Next

How can I copy object types in VB.NET?

I am building an ASP.NET application that needs dynamic tables. That's another issue that I've already posted about (and gotten a pretty good response!). Now, I'm running into another issue - I want to add new rows to my table, but given that I will have 10-12 tables on one page, each containing different objects in their rows (text boxes, check boxes, etc.) I need a way of simply generically adding a new row that has the same objects as the first row in the table. Here's my code:
Private Sub AddTableRow(ByRef originalTable As System.Web.UI.WebControls.Table)
Dim originalRow As System.Web.UI.WebControls.TableRow = originalTable.Rows(1)
Dim insertingRow As New System.Web.UI.WebControls.TableRow
Dim insertingCells(originalRow.Cells.Count) As System.Web.UI.WebControls.TableCell
Dim index As Integer = 0
For Each cell As System.Web.UI.WebControls.TableCell In originalRow.Cells
insertingCells(index) = New System.Web.UI.WebControls.TableCell
insertingCells(index).Controls.Add(cell.Controls.Item(0))
index += 1
Next
insertingRow.Cells.AddRange(insertingCells)
originalTable.Rows.Add(insertingRow)
End Sub
But I'm getting a null reference exception at the second to last line,
insertingRow.Cells.AddRange(insertingCells)
...and I can't figure out why. Is it because the contents of each cell are not being initialized with a new object? If so, how would I get around this?
Thanks!
EDIT:
The inside of my for loop now looks like this -
For Each cell As System.Web.UI.WebControls.TableCell In originalRow.Cells
Dim addedContent As New Object
Dim underlyingType As Type = cell.Controls.Item(0).GetType
addedContent = Convert.ChangeType(cell.Controls.Item(0), underlyingType)
insertingCells(index) = New System.Web.UI.WebControls.TableCell
insertingCells(index).Controls.Add(addedContent)
index += 1
Next
Stepping through with a debugger, I see that this strategy is working - but the additional table row still doesn't appear...and still does when I do this statically.
I think your culprit may be this line:
Dim insertingCells(originalRow.Cells.Count) As TableCell
Confusingly, the number you specify in an array declaration in VB.NET is the upper bound, not the number of elements. So Dim ints(10) As Integer will create an Integer() array with eleven elements, not ten (10 will be the highest index of the array).
Try this instead:
Dim insertingCells(originalRow.Cells.Count - 1) As TableCell

Resources