Executing macro on all worksheets in variant array - issue referring to array objects in for loop

Question

I am writing a macro that will loop through 29 worksheets and take data from them to build a formatted estimate in another worksheet. I have worked out the basic code I'd like to execute on each worksheet, but am having trouble employing it in the for loop. I suspect that my issue has something to do with the items in the array being string data, or the wrong kind of object. But I have been unable to resolve it.

UPDATE: I resolved the initial error in the statement below by following the advice in the answers and comments below to remove the unnecessary with block.

I changed this:

 With WshtNameCrnt
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlValues, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        LastRow = 1

To this:

'Find last row on current worksheet      
 If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow = .Cells.Find(What:="*", _
                        After:=.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlValues, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        Else
            LastRow = 1
        End If

So that resolved that problem, because as YowE3K pointed out "Within a With block, the use of a . with no object preceding it tells VBA to apply the method / property to the object defined in the With statement, so (for example) within a With xyz block, the code .Cells is interpreted as xyz.Cells."

The next issue I got in the code was on the line:

'pull sub-categories from current worksheet tab to estimate page
    est_sht.Range(est_sht.Cells(EstLastRow, 3), est_sht.Cells(NumRows + EstLastRow, 3)).Value = Worksheets(WshtNames(WshtNameCrnt)).Range(WshtNameCrnt.Cells(4, 1), WshtNameCrnt.Cells(LastRow, 1)).Value

I resolved that by removing the WshtNameCrnt references and changing the statement to:

'pull sub-categories from current worksheet tab to estimate page
        est_sht.Range(est_sht.Cells(EstLastRow, 3), est_sht.Cells(NumRows + EstLastRow, 3)).Value = .Range(.Cells(4, 1), .Cells(LastRow, 1)).Value

EDIT: I'm including the entire (not yet polished) macro script for context with some minor changes I've made:

Dim answer As Integer
Dim InputPercentage As Integer
Dim ws As Variant
Dim StartTime As Double
Dim SecondsElapsed As Double

'declare other variables
Dim WorkingPercentage As Variant
Dim EstimateDate As Variant
Dim LastRow As Variant
Dim EstLastRow As Variant
Dim NumRows As Integer
Dim rng As Range
Dim SourceRange As Range
Dim fillrange As Range
Dim sheetname As String

'declare worksheet variables'
Dim est_sht As Worksheet

Sub IterateSheets()

'associate worksheet variables with job categories worksheets
Set est_sht = ActiveWorkbook.Sheets("Estimate Report")
'declare other variables

Dim WshtNameCrnt As Variant
Dim WshtNames As Variant

'prompt user whether estimate sheets are completely filled out"
answer = MsgBox("Have you completed the estimate for all relevant labor categories?", vbYesNo + vbQuestion, "Populate Estimate")

If answer = vbYes Then

'prompt user for markup percentage
InputPercentage = Application.InputBox("What deposit percentage would you like to charge?", "Enter a number", , , , , , Type:=1)

'prompt user for date to be displayed on estimate
'EstimateDate = Application.InputBox("What date would you like on the estimate document?  Please enter as MM/DD/YYYY.", "Date")

WorkingPercentage = InputPercentage / 100

'clear out estimate sheet
est_sht.Cells.Clear

'set row height of top accent bar
est_sht.Rows("1:1").RowHeight = 10

'set color of top accent bar
With est_sht.Range("A1:J1").Interior
.Color = vbBlack
End With

'set row 2 height
est_sht.Rows("2:2").RowHeight = 16.5

'set row 3 height
est_sht.Rows("3:3").RowHeight = 130

'set text formatting
With est_sht.Rows("3:3").Font
        .Name = "Arial"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.349986266670736
        .ThemeFont = xlThemeFontMajor
    End With
est_sht.Rows("3:3").Font.Bold = True

'Date stamp the estimate based on form input
est_sht.Cells(3, 3).Value = EstimateDate

'title the estimate
est_sht.Cells(3, 5).Value = "Cost Estimate"

'Insert header row text'
est_sht.Cells(4, 3).Value = "PROJECT TASKS"
est_sht.Cells(4, 4).Value = "Cost Estimate"
est_sht.Cells(4, 5).FormulaR1C1 = InputPercentage & "% Deposit"
est_sht.Cells(4, 6).Value = "Current Costs"

'format header row of first labor subcategory
With est_sht.Range("C4:F4").Font
        .Name = "Arial"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.349986266670736
        .ThemeFont = xlThemeFontMajor
    End With
est_sht.Range("C4:F4").Font.Bold = True

'create variant array of worksheets
WshtNames = Array("permits", "project management", "in progress design", "site prep", "services on site", "layout", "concrete", "water management", "framing", "roofing and sheet metal", "electrical", "plumbing", "HVAC", "windows and doors", "exterior finishes", "insulation", "drywall", "painting", "cabinetry", "countertops", "interior finishes", "flooring", "tile", "deck garden", "landscaping", "appliances", "punchlist", "add-ons", "contingency")

'loop through worksheets
  For WshtNameCrnt = LBound(WshtNames) To UBound(WshtNames)
     With Worksheets(WshtNames(WshtNameCrnt))
        'Debug.Print "Cell B3 of worksheet " & .Name & " contains " & .Range("B3").Value

        'find last row on estimate page
        With est_sht
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                EstLastRow = .Cells.Find(What:="*", _
                            After:=.Range("B1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlValues, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
            Else
                EstLastRow = 1
            End If
        End With

        'add sheet name to table
        est_sht.Cells(EstLastRow + 2, 3).Value = .Name

        'format sub-header
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + 2, 6)).Font.Bold = True

        'Find last row on current worksheet
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                LastRow = .Cells.Find(What:="*", _
                            After:=.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlValues, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
            Else
                LastRow = 1
            End If
        Debug.Print "Last row on " & WshtNameCrnt & " is " & LastRow

        'count the number of rows filled with sub-categories'
        NumRows = LastRow - 4

      Debug.Print "Number of rows on " & WshtNameCrnt & " is " & NumRows

        'pull sub-categories from current worksheet tab to estimate page
        est_sht.Range(est_sht.Cells(EstLastRow, 3), est_sht.Cells(NumRows + EstLastRow, 3)).Value = Worksheets(WshtNames(WshtNameCrnt)).Range(WshtNameCrnt.Cells(4, 1), WshtNameCrnt.Cells(LastRow, 1)).Value

        'add sequential numbers next to labor categories on estimate page
        est_sht.Cells(EstLastRow + 2, 2).FormulaR1C1 = "1"
        est_sht.Cells(EstLastRow + 3, 2).FormulaR1C1 = "2"
        Set SourceRange = est_sht.Range(est_sht.Cells(EstLastRow + 2, 2), est_sht.Cells(EstLastRow + 3, 2))
        Set fillrange = est_sht.Range(est_sht.Cells(EstLastRow + 2, 2), est_sht.Cells(EstLastRow + NumRows, 2))
        SourceRange.AutoFill Destination:=fillrange

        'set black fill color in sequential numbers sidebar
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 2), est_sht.Cells(EstLastRow + NumRows, 2)).Interior
        .Color = vbBlack
        End With
        'format text color of sequential numbers
        With est_sht.Range(est_sht.Cells(EstLastRow + 3, 2), est_sht.Cells(EstLastRow + NumRows, 2)).Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        'format sequential numbers bold
        est_sht.Range(est_sht.Cells(EstLastRow + 3, 2), est_sht.Cells(EstLastRow + NumRows, 2)).Font.Bold = True

        'copy labor cost subtotal to estimate page
        est_sht.Cells(EstLastRow + 2, 4).Value = WshtNameCrnt.Range("F2").Value

        'populate deposit formula in estimate page
        est_sht.Cells(EstLastRow + 2, 5).FormulaR1C1 = "=RC[-1]*" & WorkingPercentage
        'populate sum formula in "current costs" for labor category
        est_sht.Cells(EstLastRow + 2, 6).FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"

        'format table around sub-category items and costs
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlDiagonalDown).LineStyle = xlNone
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlDiagonalUp).LineStyle = xlNone

        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        est_sht.Range(est_sht.Cells(EstLastRow + 2, 3), est_sht.Cells(EstLastRow + NumRows, 6)).Borders(xlInsideHorizontal).LineStyle = xlNone

      End With
  Next WshtNameCrnt

'end of main if/else loop, and end of sub'

Else
    Exit Sub
End If

End Sub

Thanks in advance for any help!

Answer 1

As Jeeped said in a comment, "Change With WshtNameCrnt to With Worksheets(WshtNames(WshtNameCrnt))". This is necessary because WshtNameCrnt is just a numeric value, not an object, and is an index into the WshtNames array.

However, that With block is not even necessary. At the point where the error is occurring you are already within a With Worksheets(WshtNames(WshtNameCrnt)) block, so you don't need to have another one.

If you use consistent indentation, the existence of the outer With block becomes more apparent:

'create variant array of worksheets
WshtNames = Array("permits", "project management", "in progress design", _
            "site prep", "services on site", "layout", "concrete", "water management", _
            "framing", "roofing and sheet metal", "electrical", "plumbing", "HVAC", _
            "windows and doors", "exterior finishes", "insulation", "drywall", _        
            "painting", "cabinetry", "countertops", "interior finishes", "flooring", _
            "tile", "deck garden", "landscaping", "appliances", "punchlist", "add-ons", _
            "contingency")

'loop through worksheets
For WshtNameCrnt = LBound(WshtNames) To UBound(WshtNames)
    With Worksheets(WshtNames(WshtNameCrnt))

        'find last row on estimate page
        With sh32
            If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                EstLastRow = .Cells.Find(What:="*", _
                                         After:=.Range("B1"), _
                                         Lookat:=xlPart, _
                                         LookIn:=xlValues, _
                                         SearchOrder:=xlByRows, _
                                         SearchDirection:=xlPrevious, _
                                         MatchCase:=False).Row
            Else
                EstLastRow = 1
            End If
        End With

        'add sheet name to table
        sh32.Cells(EstLastRow + 2, 3).Value = .Name

        'format sub-header
        sh32.Range(sh32.Cells(EstLastRow + 2, 3), sh32.Cells(EstLastRow + 2, 6)).Font.Bold = True

        'Find last row on current worksheet
        'With WshtNameCrnt <-- not needed
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow = .Cells.Find(What:="*", _
                                  After:=.Range("A1"), _
                                  Lookat:=xlPart, _
                                  LookIn:=xlValues, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=False).Row
        Else
            LastRow = 1
        End If
        'End With <-- not needed

Answer 2

I don't think you set WshtNameCrnt as an object, it's just a text variable holding the worksheet name. Try this:

With WorkSheet(WshtNameCrnt)
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlValues, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        LastRow = 1

Answer 3

It appears that sh32 is not initiated and that it should be set to Worksheets(WshtNames(WshtNameCrnt)). In any case, you should break your code into smaller tasks. In this way, you will be able to test each piece of code independently. This will greatly simplify debugging.

Option Explicit

Sub Main()
    Dim rw As Long
    Dim ws As Worksheet
    For Each ws In getWorksheets
        With ws
            rw = getLastUsedRow(ws)
            .Cells(rw + 2, 3).Value = .Name
            .Cells(rw + 2, 3).Resize(1, 3).Font.Bold = True
        End With
    Next
End Sub

Function getWorksheets() As Worksheets
    Set getWorksheets = ThisWorkbook.Worksheets(Array("permits", "project management", "in progress design", "site prep", "services on site", "layout", "concrete", "water management", "framing", "roofing and sheet metal", "electrical", "plumbing", "HVAC", "windows and doors", "exterior finishes", "insulation", "drywall", "painting", "cabinetry", "countertops", "interior finishes", "flooring", "tile", "deck garden", "landscaping", "appliances", "punchlist", "add-ons", "contingency"))
End Function

Function getLastUsedRow(ws As Worksheet) As Long
    With ws
        If Application.WorksheetFunction.CountA(.Cells) = 0 Then
            getLastUsedRow = 1
        Else
            getLastUsedRow = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        End If
    End With
End Function