2
\$\begingroup\$

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
Improve this question
\$\endgroup\$
0

1 Answer 1

Reset to default
3
\$\begingroup\$

Reasons you may be slow:

  1. Unneeded formulas
  2. Writing data that already exists
  3. Working on the worksheet!

Is there a reason that you're erasing all of your data each time you run the macro? Why not leave it and check if it exists? It looks to me like you're using a lot of formulas, which means they would update themselves, so you're doing things that don't need to be done - the formula will update itself as the information changes.

Formulas written in VBA

You're using a lot of With blocks instead of using variables. Again, writing formulas and not using variables seems counter-intuitive to me.

That being said, why are you using formulas if you're using VBA to update the target sheet? Either access the data and write it or just leave the formulas be.

Code clarity

In your blocks I see things like this:

 .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

It's very difficult to

  1. Tell what is commented out and why. If you don't need it, delete it.
  2. Tell what exactly is going on, you have comments, but you're not actually telling me anything about the process or the code. Comments should be used to explain why something is happening - not how. The how can be seen in the code.

I see this particular With block:

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

How is that working? You are declaring Z as an integer every loop - move that outside the For and just adjust its value. Also, your indenting isn't correct, each condition or loop should be on its own level starting on the left.

For 
    If  Then
        Do Until 
            'stuff
        Loop
    End If
Next

Now we can keep track of what's going on.

Lack of variables - Use Them!

Let's use some variables here that describe what's happening:

Dim summarySheet As Worksheet
Set summarySheet = ThisWorkbook.Sheets("Sheet1")
Dim currentAndUpcomingSheet As Worksheet
Set currentAndUpcomingSheet = ThisWorkbook.Worksheet("Current & Upcoming Projects")
Dim completedProjectSheet As Worksheet
Set completedProjectSheet = ThisWorkbook.Sheets("Completed Project Info")
Dim dataSheet As Worksheet
Set dataSheet = ThisWorkbook.Sheets("Data")

Ah, now we have some clarity. But, in fact, there's an even better way. Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.

Accessing the sheets

Now the main reason you're slow - you are accessing the worksheet(s) multiple times!

Every line like this:

.Cells(x, "B").Formula = "='" & ws.Name & "'!$B$5"

is hitting two worksheets every time it's run. That's the last thing you need - just read the data from the worksheet into an array instead, that way you hit the sheet once, find information in the array (behind the scenes), create an output array, then access the target once.

If ws.Range("A5") = "Project # :" And ws.Range("E16") >= sheet6.Range("F1") Then

On every sheet you're checking A5 for the same string.

Const PROJECT_NUMBER As String = "Project # :"
if ws.range("A5") = PROJECT_NUMBER and ws....

See how it can be cleaner by using a constant?

>=sheet6.Range("F1")

woah woah, what's sheet6? Seriously, that came out of nowhere and I have no idea what it is or why you're checking it.

Basics

Let's do some basic things first:

Dim numberOfSheets As Long
numberOfSheets = ThisWorkbook.Sheets.Count

Now you don't need any of the For Each loops, you can just use a For loop"

dim currentSheet as long
For currentSheet = 1 to numberOfSheets

It's much easier to work with a known population if you can.

Since we know our sheets, we can get rid of all of the With blocks and instead just target with the name.

with worksheets("Sheet1")
    .cells(x,1) = ...

becomes

projectSheet.cells(x,1) =

That would simplify your code a lot. But if we want to address the speed, we're going to have to use some arrays..

Arrays

First you need to decide if you want the formulas written, or you want the data written. If it's the formula, stop unneeded rewriting of it.

If you'd rather populate your sheets with the data instead of formulas, that should be clean enough, especially if you know where everything is. So something like this for each With block:

Option Explicit

Sub Run_ALL_InfoMacros()
Const PROJECT_NUMBER As String = "Project # :"

Dim summarySheet As Worksheet
Set summarySheet = ThisWorkbook.Sheets("Sheet1")
Dim currentAndUpcomingSheet As Worksheet
Set currentAndUpcomingSheet = ThisWorkbook.Worksheet("Current & Upcoming Projects")
Dim completedProjectSheet As Worksheet
Set completedProjectSheet = ThisWorkbook.Sheets("Completed Project Info")
Dim dataSheet As Worksheet
Dim targetSheet As Worksheet
Set dataSheet = ThisWorkbook.Sheets("Data")
Dim numberOfSheets As Long
numberOfSheets = ThisWorkbook.Sheets.Count
Dim currentSheet As Long
Dim index As Long
Dim sourceData As Variant
Dim targetData As Variant
ReDim targetData(1 To 27)

For currentSheet = 1 To numberOfSheets
    Set targetSheet = ThisWorkbook.Sheets(currentSheet)
    If targetSheet.Range("A5") = PROJECT_NUMBER Then
        Set sourceData = currentSheet.Range("A1:F17")
        index = 1
        targetData(index) = targetSheet.Name
        targetData(index + 1) = sourceData(5, 2)
        targetData(index + 2) = sourceData(1, 1)
        '...etc
        summarySheet.Range("A1:AA1") = targetData
    End If
Next

See how you access the data sheet once, process it behind the scenes and then access the destination sheet once? That alone will speed you up without even touching on the other standard tips.

You can see I used variant arrays. You can think of these as tables of values, similar to your spreadsheet. You can either give them a size or declare them variant. Because your data is of all different types, I used variants. I did ReDim the targeteData() to the size of the output because that's known.

So in one fell swoop Set sourceData = currentSheet.Range("A1:F17") you read the entire range into an array that is 17x6. Because this array starts at A1 - it would be sourceData(1,1) - same as cells() row then column. So you access each data point in the sourceData by calling the row and the column, as the array is two-dimensional. Reading it into the one dimensional array of targetData requires you only specify the row value of the array because it's only one column.

Improve this answer
\$\endgroup\$
3
  • \$\begingroup\$ This is a good answer and it addresses a lot of clean up items, shows how to clean it up, and I agree with them all. Unfortunately it is completely bereft of details on how to actually speed up the code. You tell OP to use arrays, but give him no detail or info on how to use them. Sure, there are plenty of VBA/Excel questions on CR that show it, but you went to all the trouble with the other items (which are also spread all around CR), why not the one critical thing that answers the question. Edit that in and it will go from good to great! \$\endgroup\$
    – FreeMan
    Aug 18, 2016 at 12:13
  • \$\begingroup\$ Looks good to me now! Maybe you were editing while I was commenting? \$\endgroup\$
    – FreeMan
    Aug 18, 2016 at 12:31
  • \$\begingroup\$ @FreeMan no, I put it in after you pointed it out \$\endgroup\$
    – Raystafarian
    Aug 18, 2016 at 12:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.