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.

 

[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

 

[KentBurel]

I think I'm making progress. I have altered my code to keep everything in the array called precinctArray. I'm getting a 1004 error when I try to write out the array to the new sheet. Since the number of rows varies with every sheet but the number of columns is the same, I've moved the ReDim inside the main loop. I set a watch on precinctArray and all looks good. I don't use all the cells so some of the cells are empty. Do I have to have something in every cell in order to write the entire array to the 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 columnHeaders           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 number_of_rows          As Integer
    Dim outRange                As Range
    Dim sheetName               As String
 
'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)
    columnHeaders = Worksheets("BMD PT").Range("A3:V3") ' Read in column headers
  
    For i = 1 To last
        precinct = precincts(i, 1)
        precinctLocation = precincts(i, 2)
        number_of_BMDs = precincts(i, 5)
        number_of_rows = number_of_BMDs + 3
       
        ReDim precinctArray(1 To number_of_rows, 1 To 23)
        For row = 1 To number_of_rows
            Select Case row
                Case 1
                    precinctArray(row, 1) = precinct
                    precinctArray(row, 2) = precinctLocation
                Case 2
                    precinctArray(row, 1) = " "
                Case 3
                    For column = 1 To 22
                        precinctArray(row, column) = columnHeaders(1, column)
                    Next column
                Case Else
                    precinctArray(row, 1) = row - 3
                    precinctArray(row, 2) = "=Vlookup(""" & precinct & "_" & j & _
                                            ",BMDData,2,False"
                    For column = 3 To 15
                        precinctArray(row, column) = ChrW(136)
                    Next column
                    precinctArray(row, 16) = "?"
                    precinctArray(row, 17) = ChrW(136)
                    precinctArray(row, 18) = "=Vlookup(""" & precinct & "_" & j & _
                                            ",BMDData,3,False"
                    precinctArray(row, 19) = "=Vlookup(""" & precinct & "_" & j & _
                                            ",BMDData,4,False"
            End Select
        Next row
               
' Now set the counters that control the stoplight
        precinctArray(8, 23) = number_of_BMDs * 21 ' Columns A-U times number of rows
        precinctArray(9, 23) = "=COUNTA(R4C1:R" & number_of_rows & "C2)" & _
                                "+COUNTIF(R4C3:R" & number_of_rows & "C17,UNICHAR(254))" & _
                                "+COUNTIF(R4C16:R" & number_of_rows & "C16,0)" & _
                                "+COUNTA(R4C18:R" & number_of_rows & "C21)"

        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
     
        Sheets(sheetName).Range(Cells(1, 1), Cells(number_of_rows, 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]

The most likely reason you are getting an error when writing the array back to the worksheet is because one of the formulae is in error. The way I find these is I take the "=" ( the equals sign) out of what is written by the VBA, this means the VBA is just writing a text string. Then go to each cell in turn and add the equals sign in manually, EXCEL will kindly tell you where the error is.

 

[KentBurel]

The most likely reason you are getting an error when writing the array back to the worksheet is because one of the formulae is in error. The way I find these is I take the "=" ( the equals sign) out of what is written by the VBA, this means the VBA is just writing a text string. Then go to each cell in turn and add the equals sign in manually, EXCEL will kindly tell you where the error is.

I’m seeing some strange behavior. If the formula is placed on the sheet as part of an array assignment then it is not interpreted. If the same text is assigned to a range directly (that is, it is not first stored in the array, then it is interpreted correctly.

What’s the difference between assigning a formula to the range.value property or the range.formular1c1 property.

 

[KentBurel]

I found this sentence on the web:

If the array being passed to the worksheet is smaller than the Range to which it is written, the unused cells get a #N/A error. If the array being passed is larger than the range to which it is written, the array is truncated on the right or bottom to fit the range.

I got this at this url:

Arrays And Ranges In VBA

www.cpearson.com

Is this true? I can’t get the array to write to a range if the array and the range are not exactly the same size.

I have formulas in column 2, 18 and 19. All the formulas in each of the 3 columns are exactly the same (they’re R1c1 formulas). So I want to define range 1 for column 2, range 2 for columns 18 and 19 and the write the formula array to the union of range 1 and range 2. The only problem is, it doesn’t work.

 

[offthelip]

When writing formula and values to an array, you need to take the .value out of the assignment:
e.g:

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

should be:

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

this statement :
"If the array being passed to the worksheet is smaller than the Range to which it is written, the unused cells get a #N/A error. If the array being passed is larger than the range to which it is written, the array is truncated on the right or bottom to fit the range."
is TRUE. However it is usually worth trying to get the range to be the same size as the array and shouldn't be difficult, you have got the number of rows as a variable.

"I have formulas in column 2, 18 and 19. All the formulas in each of the 3 columns are exactly the same (they’re R1c1 formulas). So I want to define range 1 for column 2, range 2 for columns 18 and 19 and the write the formula array to the union of range 1 and range 2. The only problem is, it doesn’t work. "
If you are having trouble getting the formula coming out correctly using vba i find the best way to solve this is to remove the equals sign from the VBA so that it writes text to the cells instead of a formula and then go to the cell, manually add the equals sign back in, then excel will tell you where the error is.