Need help with snail paced macro

[KentBurel]

I've created a monster. I'm still a novice at VBA. I've been working on this project for a few weeks. I have a workbook that contains sheets that I use to build other sheets. The templates contain all the data I need in the final sheets. So I just copy the sheet to a new sheet, rename it, set a few variables and delete the rows I don't need. The template contains 30 rows and the output sheet have a variable number of rows. The most rows of any output sheet is 18. I built the template at 30 row so that I might accomodate environments that are bigger in the future. My code is below. Here is the immediate window of executing the macro.:
Precinct 1 began at 5/22/2020 5:24:52 PM
Precinct 2 began at 5/22/2020 5:25:08 PM
Precinct 3 began at 5/22/2020 5:26:54 PM
Precinct 4 began at 5/22/2020 5:28:14 PM
Precinct 5 began at 5/22/2020 5:29:04 PM
Precinct 6 began at 5/22/2020 5:29:51 PM
Precinct 7 began at 5/22/2020 5:30:16 PM
Precinct 8 began at 5/22/2020 5:31:19 PM
Precinct 9 began at 5/22/2020 5:32:35 PM
Precinct 10 began at 5/22/2020 5:33:21 PM
Precinct 11 began at 5/22/2020 5:34:06 PM
Precinct 12 began at 5/22/2020 5:35:20 PM
Precinct 13 began at 5/22/2020 5:36:15 PM
Precinct 14 began at 5/22/2020 5:37:21 PM
Precinct 15 began at 5/22/2020 5:38:16 PM
Precinct 16 began at 5/22/2020 5:39:13 PM
Precinct 17 began at 5/22/2020 5:40:22 PM
Precinct 18 began at 5/22/2020 5:41:24 PM
Precinct 19 began at 5/22/2020 5:42:24 PM
Precinct 20 began at 5/22/2020 5:42:43 PM
Precinct 21 began at 5/22/2020 5:43:40 PM
Precinct 22 began at 5/22/2020 5:44:40 PM
Precinct 23 began at 5/22/2020 5:45:23 PM
Precinct 24 began at 5/22/2020 5:46:34 PM
Precinct 25 began at 5/22/2020 5:47:21 PM
Precinct 26 began at 5/22/2020 5:48:04 PM
Precinct 27 began at 5/22/2020 5:48:26 PM
Precinct 28 began at 5/22/2020 5:49:45 PM
Precinct 29 began at 5/22/2020 5:50:35 PM

Option Explicit

Sub BuildAllBMDPrecincts()

    Dim precincts()         As Variant
    Dim precinct            As String
    Dim precinctLocation    As String
    Dim i                   As Integer
    Dim last                As Integer
    Dim number_of_BMDs      As Integer
    Dim outRange            As Range
    Dim sheetName           As String
    Dim firstRow            As Integer
    Dim lastRow             As Integer
  
'Turn off calculations for a bit
    Application.Calculation = xlManual
  
' Turn off screen updating
    Application.ScreenUpdating = False
  
' Turn off events
    Application.EnableEvents = False

    precincts = Range("Precincts")
    last = UBound(precincts)
  
    For i = 1 To last
        Debug.Print "Precinct " & i & " began at " & Now
        precinct = precincts(i, 1)
        precinctLocation = precincts(i, 2)
        number_of_BMDs = precincts(i, 5)
      
        DoEvents
        Application.StatusBar = "Creating precinct sheet " & i & " of " & last
      
        sheetName = precinct & "-B"
        Sheets("BMD Precinct Template").Copy After:=Sheets(Sheets.Count)
        Sheets("BMD Precinct Template (2)").Name = sheetName
        Sheets(sheetName).PageSetup.LeftHeader = "Polling Place: " & precinct
        Sheets(sheetName).Visible = True
  
' Now set the counters that control the stoplight
        Sheets(sheetName).Range("W8").Value = number_of_BMDs * 21 ' Columns A-U times number of rows
        firstRow = 4 ' The table starts on row 4
        lastRow = 4 + number_of_BMDs - 1 ' The last Row
        Sheets(sheetName).Range("W9").FormulaR1C1 = "=COUNTA(R4C1:R" & lastRow & "C2)" & _
                                         "+COUNTIF(R4C3:R" & lastRow & "C17,UNICHAR(254))" & _
                                         "+COUNTIF(R4C16:R" & lastRow & "C16,0)" & _
                                         "+COUNTA(R4C18:R" & lastRow & "C21)"
                                       
        Sheets(sheetName).Range("A1").Value = precinct
        Sheets(sheetName).Range("B1").Value = precinctLocation
      
' Now only show the rows and columns that are relevant.  Don't show or print others.
        Sheets(sheetName).Columns("W").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.EntireColumn.Hidden = True
        Sheets(sheetName).Range("A" & lastRow + 1 & ":U33").ClearContents
        Rows(lastRow + 1).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.EntireRow.Hidden = True
  
' Now protect the new precinct BMD sheet
    Sheets(sheetName).Protect
    Next i
  
    Application.StatusBar = "Recalculating workbook."
  
' Restore automatic calculations
    Application.Calculation = xlAutomatic
  
    Application.StatusBar = False
  
    Application.ScreenUpdating = True
  
    ' Turn on events
    Application.EnableEvents = True
  

End Sub

The template and the output sheet are designed to have a VLOOKUP formula in 3 columns. I saw on this forum that dynamic formulas can make the code run slowly so I have removed them for now (before the run that produced these timings.) The template sheet also has automation code in the Worksheet.Change and Worksheet.Selectionchange event handlers but I have removed it until I can figure out the source of my performance issues. This is the only code at the workbook level:

Option Explicit
Sub Workbook_open()
    DisplayConstantsHelp.Show
End Sub

I appreciate your guidance and help.

 

[offthelip]

The reason your macro runs at a snails pace is because you have multiple accesses to the worksheet in a loop. VBA is very fast until you need to read or write anything to the worksheet, then it is very slow. However the time taken to read or write a large range of cells is almost the same as the time to read or write a single cell. So to really speed up your macro you need to redesign it so that you minimise then number of interactions with the worksheet. To do this depends on what is on the template, i.e how much formatting, how many equations, how many cells have data in them, how often does the template change.

 

[KentBurel]

I understand your recommendation. I will implement it. Yet I think something in addition is going on as well. When I do a simple copy of a worksheet in my workbook, the operation takes approximately 31 seconds. This is consistent. So I inserted a new blank worksheet. Then I made a copy of the new sheet and it also took about 31 seconds. It seems that my workbook is corrupt or it's running event code that I can't find. Please help me understand why worksheet functions taks so long.

 

[offthelip]

You could have a problem with the "used range" of the worksheets in your workbook which could make copying the worksheet very slow. Sometimes the last cell somehow gets set thousand of rows or hundreds of columns too large, either because of excess formatting or because a large number of cells, rows or columns have been inserted or deleted. This can cause the file size and memory used to grow very large. I use this macro to test this:

Sub Uranger()
inarr = ActiveSheet.UsedRange.Address

MsgBox (inarr)

End Sub

Another possibility for it being so slow is because the recalculation time is very long, this depends on what is in the workbook

 

[offthelip]

"Please help me understand why worksheet functions takes so long."
It is not Worksheet functions that take a long time it is references to the worksheet . I have taken a bit of your code and deleted all the code lines which ARE NOT references to the worksheet. i.e every line here is SLOW!!

        Sheets("BMD Precinct Template").Copy After:=Sheets(Sheets.Count)
        Sheets("BMD Precinct Template (2)").Name = sheetName
        Sheets(sheetName).PageSetup.LeftHeader = "Polling Place: " & precinct
        Sheets(sheetName).Visible = True
 
' Now set the counters that control the stoplight
        Sheets(sheetName).Range("W8").Value = number_of_BMDs * 21 ' Columns A-U times number of rows
        Sheets(sheetName).Range("W9").FormulaR1C1 = "=COUNTA(R4C1:R" & lastRow & "C2)" & _
                                         "+COUNTIF(R4C3:R" & lastRow & "C17,UNICHAR(254))" & _
                                         "+COUNTIF(R4C16:R" & lastRow & "C16,0)" & _
                                         "+COUNTA(R4C18:R" & lastRow & "C21)"
                                      
        Sheets(sheetName).Range("A1").Value = precinct
        Sheets(sheetName).Range("B1").Value = precinctLocation
      
' Now only show the rows and columns that are relevant.  Don't show or print others.
        Sheets(sheetName).Columns("W").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.EntireColumn.Hidden = True
        Sheets(sheetName).Range("A" & lastRow + 1 & ":U33").ClearContents
        Rows(lastRow + 1).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.EntireRow.Hidden = True
 
' Now protect the new precinct BMD sheet
    Sheets(sheetName).Protect

 

[KentBurel]

You could have a problem with the "used range" of the worksheets in your workbook which could make copying the worksheet very slow. Sometimes the last cell somehow gets set thousand of rows or hundreds of columns too large, either because of excess formatting or because a large number of cells, rows or columns have been inserted or deleted. This can cause the file size and memory used to grow very large. I use this macro to test this:

Sub Uranger()
inarr = ActiveSheet.UsedRange.Address

MsgBox (inarr)

End Sub

Another possibility for it being so slow is because the recalculation time is very long, this depends on what is in the workbook

I have written a small VBA that reports on the Usedrange.address of every sheet in the workbook. Here are the results:

UsedRangeAddress for Sheet BMD Template is $A$1:$J$998
UsedRangeAddress for Sheet BMD Precinct Template is $A$1:$W$100
UsedRangeAddress for Sheet BMD Precinct Rows is $A:$W
UsedRangeAddress for Sheet BMD Master is $A$1:$J$1028
UsedRangeAddress for Sheet Constants is $A:$M
UsedRangeAddress for Sheet Lights is $A$1:$C$1
UsedRangeAddress for Sheet Poll Pad Master Template is $A$1:$I$30
UsedRangeAddress for Sheet Poll Pad Precinct Template is $A$1:$L$58
UsedRangeAddress for Sheet Precincts is $A$1:$M$80
UsedRangeAddress for Sheet Scanner Master is $A$1:$I$60
UsedRangeAddress for Sheet Scanner Precinct Template is $A$1:$XFC$42
UsedRangeAddress for Sheet Scanner Template is $A$1:$I$2

This is a mystery to me. The BMD Master only goes to row 289. The Sheet Scanner Precinct Template only needs 10 rows and 25 columns. How do I reset the Usedrange to the actual Used Range?

 

[offthelip]

The two that look suspicious to me are Precinct Rows and Constants because both of these seem to have the entire columns A to W and A to M in the used range. That might be a problem.

 

[KentBurel]

The two that look suspicious to me are Precinct Rows and Constants because both of these seem to have the entire columns A to W and A to M in the used range. That might be a problem.

I understand. How do I reset them?

 

[KentBurel]

I have altered my code like you suggest. I now create a 2 dimensional array and put all my data in it and then want to write it to a range in one operation. My research informs me that the dimensions of my array and the dimensions of the output range must be the same. Is that correct? I declare the precinctArray as dynamic and the ReDim it to the maximum size and build all the elements. All of the rows in the target sheet are the same. The only variable is the number of rows which is stored in the number_of_BMDs variable. But RdDim will only allow me to change the last dimension. How can I have a variable number of rows on my output sheet?

Option Explicit
Option Base 1

Sub BuildAllBMDPrecincts()

    Dim precincts()             As Variant
    Dim precinct                As String
    Dim precinctLocation        As String
    Dim precinctArray()         As Variant
    Dim precinctArrayRow3       As Variant
    Dim row                     As Integer
    Dim column                  As Integer
    Dim last                    As Integer
    Dim i                       As Integer
    Dim j                       As Integer
    Dim number_of_BMDs          As Integer
    Dim outRange                As Range
    Dim sheetName               As String
    Dim firstRow                As Integer
    Dim lastRow                 As Integer
   
'Turn off calculations for a bit
    Application.Calculation = xlManual
   
' Turn off screen updating
    Application.ScreenUpdating = False
   
' Turn off events
    Application.EnableEvents = False

    precincts = Range("Precincts")
    last = UBound(precincts)
    precinctArrayRow3 = Worksheets("BMD PT").Range("A3:V3")
    ReDim precinctArray(1 To 34, 1 To 23)
    For column = 1 To 22
        precinctArray(3, column) = precinctArrayRow3(1, column)
    Next column
   
    For row = 4 To 34
        precinctArray(row, 1) = row - 3
        For column = 3 To 15
            precinctArray(row, column) = ChrW(136)
        Next column
    Next row
    For row = 4 To 34
        precinctArray(row, 16) = "?"
        precinctArray(row, 17) = ChrW(136)
    Next row
    precinctArray(10, 23) = "=RC[-2]/RC[-1]"
       
    For i = 1 To last
        precinct = precincts(i, 1)
        precinctArray(1, 1) = precinct
        precinctArray(1, 2) = precincts(i, 2)
       
        number_of_BMDs = precincts(i, 5)
            For j = 1 To number_of_BMDs
                precinctArray(j + 4, 2) = "=Vlookup(""" & precinct & "_" & 1 & _
                                            ",BMDData,2,False"
                precinctArray(j + 4, 18) = "=Vlookup(""" & precinct & "_" & 1 & _
                                            ",BMDData,3,False"
                precinctArray(j + 4, 19) = "=Vlookup(""" & precinct & "_" & 1 & _
                                            ",BMDData,4,False"
            Next j

        Application.StatusBar = "Creating precinct sheet " & i & " of " & last
       
        sheetName = precinct & "-B"
        Sheets("BMD PT").Copy After:=Sheets(Sheets.Count)
        Sheets("BMD PT (2)").Name = sheetName
        Sheets(sheetName).PageSetup.LeftHeader = "Polling Place: " & precinct
   
' Now set the counters that control the stoplight
        precinctArray(8, 23) = number_of_BMDs * 21 ' Columns A-U times number of rows
        firstRow = 4 ' The table starts on row 4
        lastRow = 4 + number_of_BMDs - 1 ' The last Row
        precinctArray(9, 23) = "=COUNTA(R4C1:R" & lastRow & "C2)" & _
                                "+COUNTIF(R4C3:R" & lastRow & "C17,UNICHAR(254))" & _
                                "+COUNTIF(R4C16:R" & lastRow & "C16,0)" & _
                                "+COUNTA(R4C18:R" & lastRow & "C21)"
       
        ReDim Preserve precinctArray(1 To number_of_BMDs + 3, 1 To 23)
       
        Sheets(sheetName).Range("A1").Resize(number_of_BMDs, 23). _
            Value = precinctArray
   
' Now protect the new precinct BMD sheet
        Sheets(sheetName).Protect
    Next i
   
    Application.StatusBar = "Recalculating workbook."
   
' Restore automatic calculations
    Application.Calculation = xlAutomatic
   
    Application.StatusBar = False
   
    Application.ScreenUpdating = True
   
    ' Turn on events
    Application.EnableEvents = True

End Sub

 

[offthelip]

To reset the range, if you select the last row which really has got data in it, then ctrl -shift-end which select all the rows to the last used range then select delete this will reset the used range

Yes you are correct the Range must be the same size as the variant array otherwise you will either lose data (if the range is too small). or get a lot of #N/A appearing if the range is too large
To write a variant array out to a range I always use the simple range number addressing so:

Sheets(sheetName).Range("A1").Resize(number_of_BMDs, 23). _
            Value = precinctArray

Becomes

Sheets(sheetName).Range(Cells(1, 1), Cells(number_of_BMDs, 23)) = precinctArray