This workbook is used to track projects. I have this VBA code linked to a Form Control button. When I press the button it will run through and get information from all the project sheets and feed it to the appropriate areas.
My workbook currently has 25 worksheets for projects, they are labeled 1-25. These projects all have the format. This number will go up as new projects come up and it will become 26, then 27, then 28, etc. The form control button reads through each sheet and looks for "Project # :" in cell A5. I did this because any worksheet that A5 = "Project # :" is a project info sheet. The other sheets are sheets that take data from the 1-25 sheets and displays it all in different ways.
I know my code could be run more efficiently, but I am just unaware how. What it does now is reads through every sheet in the workbook looking for A5 = "Project # :" and if it finds then it takes values and puts it on "Sheet1". It then continues to read the next page and repeats that. Then it starts a whole new loop of reading through each sheet looking for "project # :" to now input data onto a different page. It does this for a few sheets.
I know it could be combined somehow. I want to figure out how I can combine some of these loops where it reads through my entire workbook.
Sub Run_ALL_InfoMacros()
'Module 5 = WIG Sheet1, for all information to be on one sheet
With Worksheets("Sheet1")
' Clear previous data on the All projects page
.Rows("2:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" Then
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project #
.Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name
.Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer
.Cells(x, "E").Formula = "='" & ws.Name & "'!$B$6" 'Maximo Time Charge
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date
.Cells(x, "G").Formula = "=IF('" & ws.Name & "'!$E$11>0,'" & ws.Name & "'!$E$11,TEXT(,))"
'.Cells(x, "G").Formula = "='" & ws.Name & "'!$E$11" 'Materials Forecast Actual
.Cells(x, "H").Formula = "='" & ws.Name & "'!$F$11" 'Forecast success
.Cells(x, "I").Formula = "='" & ws.Name & "'!$F$12" 'IFC Success
.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$6" '30% Due
'.Cells(x, "K").Formula = "='" & ws.Name & "'!$E$13" '30% actual
.Cells(x, "K").Formula = "=IF('" & ws.Name & "'!$E$13>0,'" & ws.Name & "'!$E$13,TEXT(,))"
.Cells(x, "L").Formula = "='" & ws.Name & "'!$F$13" '30% success
.Cells(x, "M").Formula = "='" & ws.Name & "'!$E$7" '60% due
'.Cells(x, "N").Formula = "='" & ws.Name & "'!$E$14" '60% actual
.Cells(x, "N").Formula = "=IF('" & ws.Name & "'!$E$14>0,'" & ws.Name & "'!$E$14,TEXT(,))"
.Cells(x, "O").Formula = "='" & ws.Name & "'!$F$14" '60% Success
.Cells(x, "P").Formula = "='" & ws.Name & "'!$E$8" '90% due
'.Cells(x, "Q").Formula = "='" & ws.Name & "'!$E$15" '90% actual
.Cells(x, "Q").Formula = "=IF('" & ws.Name & "'!$E$15>0,'" & ws.Name & "'!$E$15,TEXT(,))"
.Cells(x, "R").Formula = "='" & ws.Name & "'!$F$15" '90% success
.Cells(x, "S").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due
'.Cells(x, "T").Formula = "='" & ws.Name & "'!$E$16" 'In-service actual
.Cells(x, "T").Formula = "=IF('" & ws.Name & "'!$E$16>0,'" & ws.Name & "'!$E$16,TEXT(,))"
.Cells(x, "U").Formula = "='" & ws.Name & "'!$F$16" 'In-service Success
.Cells(x, "V").Formula = "='" & ws.Name & "'!$E$4" 'IFC Scheduled
'.Cells(x, "W").Formula = "='" & ws.Name & "'!$E$12" 'IFC Actual
.Cells(x, "W").Formula = "=IF('" & ws.Name & "'!$E$12>0,'" & ws.Name & "'!$E$12,TEXT(,))"
.Cells(x, "X").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items
.Cells(x, "Y").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time
.Cells(x, "Z").Formula = "='" & ws.Name & "'!$A$17" 'Non Stores Items Success
.Cells(x, "AA").Formula = "='" & ws.Name & "'!$B$17" 'Non Stores Items Percentage
End If
Next
End With
'Module 7 = WIG current & upcoming Projects, for all projects with NO Actual In-service Date Inputted
With Worksheets("Current & Upcoming Projects")
' Clear previous data on the All projects page
.Rows("3:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" And ws.Range("E16") = "" Then
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project #
.Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name
.Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer
.Cells(x, "E").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$6" '30% Due
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$13" '30% Success
.Cells(x, "H").Formula = "='" & ws.Name & "'!$E$7" '60% due
.Cells(x, "I").Formula = "='" & ws.Name & "'!$F$14" '60% Success
.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$8" '90% due
.Cells(x, "K").Formula = "='" & ws.Name & "'!$F$15" '90% Success
.Cells(x, "L").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date
.Cells(x, "M").Formula = "='" & ws.Name & "'!$F$11" 'Materials Forecast Success
.Cells(x, "N").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items
.Cells(x, "O").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time
.Cells(x, "P").Formula = "='" & ws.Name & "'!$A$17" 'Non Stores Items Success
End If
Next
End With
'Module 2 = WIG Completed Project Info , For all the projects that are already in-service.
With Worksheets("Completed Project Info")
' Clear previous data on the All projects page
.Rows("3:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" And ws.Range("E16") >= Sheet6.Range("F1") Then
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5" 'Project #
.Cells(x, "C").Formula = "='" & ws.Name & "'!$A$1" 'Project Name
.Cells(x, "D").Formula = "='" & ws.Name & "'!$B$8" 'Project Engineer
.Cells(x, "E").Formula = "='" & ws.Name & "'!$B$11" 'In-service Due
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$16" 'In-service Actual
.Cells(x, "G").Formula = "='" & ws.Name & "'!$E$6" '30% Due
'.Cells(x, "H").Formula = "='" & ws.Name & "'!$E$13" '30% actual
.Cells(x, "H").Formula = "='" & ws.Name & "'!$F$13" '30% Success
.Cells(x, "I").Formula = "='" & ws.Name & "'!$E$7" '60% due
'.Cells(x, "J").Formula = "='" & ws.Name & "'!$E$14" '60% actual
.Cells(x, "J").Formula = "='" & ws.Name & "'!$F$14" '60% Success
.Cells(x, "K").Formula = "='" & ws.Name & "'!$E$8" '90% due
'.Cells(x, "L").Formula = "='" & ws.Name & "'!$E$15" '90% actual
.Cells(x, "L").Formula = "='" & ws.Name & "'!$F$15" '90% Success
.Cells(x, "M").Formula = "='" & ws.Name & "'!$E$5" 'Material Forecast due date
'.Cells(x, "N").Formula = "='" & ws.Name & "'!$E$11" 'Materials Forecast Actual
.Cells(x, "N").Formula = "='" & ws.Name & "'!$F$11" 'Materials Forecast Success
.Cells(x, "O").Formula = "='" & ws.Name & "'!$B$15" 'Non Stores Items
.Cells(x, "P").Formula = "='" & ws.Name & "'!$B$16" 'Non Stores Items Ordered on time
End If
Next
End With
'For Non-Stores Material
With Worksheets("Data Sheet")
' Clear previous data on the All projects page
.Rows("141:" & Rows.Count).ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Range("A5") = "Project # :" Then
Dim Z As Integer
Z = 19
Do While Not ws.Range("A" & Z) = "" And Not IsNull(ws.Range("A" & Z))
x = .Range("A" & Rows.Count).End(xlUp).Offset(1).row
.Cells(x, "A").Value = ws.Name 'classifying number
.Cells(x, "B").Formula = "='" & ws.Name & "'!$A$" & Z 'Non-stores material
.Cells(x, "D").Formula = "='" & ws.Name & "'!$C$" & Z 'Lead Time
.Cells(x, "F").Formula = "='" & ws.Name & "'!$E$" & Z 'Order By Date
.Cells(x, "G").Formula = "='" & ws.Name & "'!$F$" & Z 'Date Ordered
.Cells(x, "H").Formula = "='" & ws.Name & "'!$G$" & Z 'Goals Met
Z = Z + 1
Loop
End If
Next
End With
End Sub