Split Material & Labour Cost within Macros

M

matthardy19

New Member
Joined
Aug 17, 2021
Messages
17
Office Version
  1. 365
Platform
  1. Windows
Hi,

I am wanting to be able to split the Materials Cost and Labour Cost to show the Total and then the grand total for each building.

I have added this formatting into the Macro already but am struggling to do the second part of defining and separating the Material & labour cost for these to calculate the individual totals.
Screenshot 2021-09-07 153937.png



The image attached is an example of building one of how it looks currently. Currently the Materials Total & Labour Total show the full total for the building along with the Total.

On my sheet the materials tabs names are: "ISP", "OSP", "Electrical", "Patch Leads", "Civils"& "Specials".

The Labour is called "Labour Cost".

Below is my full macro so far:

VBA Code: 
Sub Fill_Customer_Material()
  Dim a, Sh, Sumbldg As Variant
  Dim i, x, z, Bldg, R_Id, R_Desc, R_P, R_Q, LastRow, HeaderCnt As Long
  Dim Total, BldgSubTot, Ctrl As Double
  Dim CM As Worksheet
  Dim MatRng As String
  Dim Qty As Variant
 
 
 
  Set CM = Sheets("Customer Materials Sheet")
  HeaderCnt = 0
  Sumbldg = Array(0#, 0#, 0#, 0#)
  With CM.Range("AA1:AD5")
    Qty = .Value
  End With
 
  For Bldg = 1 To 4
        LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
       
        For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
            Select Case Sheets(Sh).Name
                Case Is = "ISP"
                    MatRng = "A3:O103"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 1
                Case Is = "OSP"
                    MatRng = "A3:P113"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 12
                    R_Q = 6 + Bldg
                    z = 2
                Case Is = "Electrical"
                    MatRng = "A3:O47"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 3
                Case Is = "Civils"
                    MatRng = "A3:O101"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 4
                Case Is = "Specials"
                    MatRng = "B3:O19"
                    R_Id = 1
                    R_Desc = 2
                    R_P = 8
                    R_Q = 2 + Bldg
                    z = 5
                 Case Is = "Labour Cost"
                    MatRng = "A3:O13"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 5
            End Select
           
            With Sheets(Sh).Range(MatRng)
                '--------------------------------------------------------------------------------
                'Check if column building qty has any values
                '--------------------------------------------------------------------------------
                Total = 0
                Ctrl = 0
                a = .Value
                For i = 1 To UBound(a)
                    If Len(a(i, R_Q)) > 0 And IsNumeric(a(i, R_Q)) Then
                        If a(i, R_Q) <> 0 Then
                            Ctrl = Ctrl + 1

                        End If
                    End If
                Next i
                                     
                Qty(z, Bldg) = Ctrl
               
   
                If Qty(z, Bldg) > 0 And IsNumeric(Qty(z, Bldg)) Then
               
                    '--------------------------------------------------------------------------------
                    'check if there's already a top header placed and if not Insert and format
                    '--------------------------------------------------------------------------------
                    If (CM.Cells(LastRow, 3).Value = "Job Description" And HeaderCnt = 0) Or (Cells(LastRow, 5).Value = "TOTAL" And HeaderCnt = 0) Then
                        With CM.Cells(LastRow, 3)
                            .Offset(3, 0).Value = "Materials List - Building: " & Bldg
                            .Offset(4, 0).Value = "Item Id"
                            .Offset(4, 1).Value = "Description"
                            .Offset(4, 2).Value = "Price"
                            .Offset(4, 3).Value = "Qty"
                            .Offset(4, 4).Value = "Total"
                        End With
                        With Range(CM.Cells(LastRow, 3).Offset(3, 0), CM.Cells(LastRow, 3).Offset(3, 4))
                                .Interior.Pattern = xlSolid
                                .Interior.PatternColorIndex = xlAutomatic
                                .Interior.Color = 15773696
                                .Interior.TintAndShade = 0
                                .Interior.PatternTintAndShade = 0
                                .Font.Size = 14
                                .Font.Bold = True
                                .Borders(xlDiagonalDown).LineStyle = xlNone
                                .Borders(xlDiagonalUp).LineStyle = xlNone
                                .BorderAround ColorIndex:=0, Weight:=xlThin
                                .Merge
                                .HorizontalAlignment = xlCenter
                        End With
                        With Range(CM.Cells(LastRow, 3).Offset(4, 0), CM.Cells(LastRow, 3).Offset(4, 4))
                                .Font.Size = 12
                                .Font.Bold = True
                                .Borders(xlDiagonalDown).LineStyle = xlNone
                                .Borders(xlDiagonalUp).LineStyle = xlNone
                                .BorderAround ColorIndex:=0, Weight:=xlThin
                                .Borders(xlInsideVertical).LineStyle = xlContinuous
                                .Borders(xlInsideVertical).ColorIndex = 0
                                .Borders(xlInsideVertical).TintAndShade = 0
                                .Borders(xlInsideVertical).Weight = xlThin
                                .HorizontalAlignment = xlCenter
                        End With
                        HeaderCnt = 1
                    End If
                   
                    '--------------------------------------------------------------------------------
                    'Insert and Format Line with Section
                    '--------------------------------------------------------------------------------
                    LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
                    If Cells(LastRow, 5).Value = "Total" Then
                        LastRow = LastRow + 1
                    End If
                    CM.Cells(LastRow, 3).Offset(1, 0).Value = Sheets(Sh).Name
                    With CM.Range(Cells(LastRow, 3).Offset(1, 0), Cells(LastRow, 3).Offset(1, 4))
                        .Interior.Pattern = xlSolid
                        .Interior.PatternColorIndex = xlAutomatic
                        .Interior.ThemeColor = xlThemeColorAccent5
                        .Interior.TintAndShade = 0.599993896298105
                        .Interior.PatternTintAndShade = 0
                        .Borders(xlDiagonalDown).LineStyle = xlNone
                        .Borders(xlDiagonalUp).LineStyle = xlNone
                        .BorderAround ColorIndex:=0, Weight:=xlThin
                    End With
   
                    '--------------------------------------------------------------------------------
                    'Fill Material Master with lines where Qty > 0 for the building involved
                    '--------------------------------------------------------------------------------
                    For i = 1 To UBound(a)
                        If Len(a(i, R_Q)) > 0 And IsNumeric(a(i, R_Q)) Then
                            If a(i, R_Q) > 0 Then
                                LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
                                '--------------------------------------------------------------------------------
                                'Next Section insert the Values
                                '--------------------------------------------------------------------------------
                                With CM.Cells(LastRow, 3)
                                    .Offset(1, 0).Value = a(i, R_Id) 'Item ID
                                    .Offset(1, 1).Value = a(i, R_Desc) 'Description
                                    .Offset(1, 2).Value = Round(a(i, R_P), 2) 'price
                                    .Offset(1, 3).Value = Round(a(i, R_Q), 2) 'Qty
                                    .Offset(1, 4).Value = Round(a(i, R_Q) * a(i, R_P), 2) 'total
                                End With
                                '--------------------------------------------------------------------------------
                                'Next Section insert the formatting
                                '--------------------------------------------------------------------------------
                                CM.Cells(LastRow, 3).Offset(1, 2).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                                CM.Cells(LastRow, 3).Offset(1, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                                With CM.Range(Cells(LastRow, 3).Offset(1, 0), Cells(LastRow, 3).Offset(1, 4))
                                    .Borders(xlDiagonalDown).LineStyle = xlNone
                                    .Borders(xlDiagonalUp).LineStyle = xlNone
                                    .BorderAround ColorIndex:=0, Weight:=xlThin
                                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                                    .Borders(xlInsideVertical).ColorIndex = 0
                                    .Borders(xlInsideVertical).TintAndShade = 0
                                    .Borders(xlInsideVertical).Weight = xlThin
                                End With
                                BldgSubTot = BldgSubTot + Round(a(i, R_Q) * a(i, R_P), 2)
                            End If
                        End If
                    Next i
                End If
            End With
            LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
            x = x + Qty(z, Bldg)
        Next Sh
        Debug.Print Sh
       
            '--------------------------------------------------------------------------------
            'Next Section insert the footer & calculation
            '--------------------------------------------------------------------------------
       
       
       
        If x > 0 Then
            With CM.Cells(LastRow, 3)
                .Offset(2, 2).Value = "Materials Total"
                .Offset(2, 4).FormulaR1C1 = BldgSubTot
                .Offset(2, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                .Offset(3, 2).Value = "Labour Total"
                .Offset(3, 4).FormulaR1C1 = BldgSubTot
                .Offset(3, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                .Offset(4, 2).Value = "Total"
                .Offset(4, 4).FormulaR1C1 = BldgSubTot
                .Offset(4, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
            End With
                       
            '--------------------------------------------------------------------------------
            'Next Section applies Double Thick line Above Total
            '--------------------------------------------------------------------------------
            With Range(CM.Cells(LastRow, 3).Offset(5, 4), CM.Cells(LastRow, 3).Offset(5, 4))
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeBottom).LineStyle = xlNone
                .Borders(xlEdgeRight).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlDouble
                .Borders(xlEdgeTop).ColorIndex = xlAutomatic
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThick
            End With
            HeaderCnt = 0
            Sumbldg(Bldg - 1) = BldgSubTot

            Total = Total + BldgSubTot
            BldgSubTot = 0
            End If
    Next Bldg
   
    '--------------------------------------------------------------------------------
    'Next Section insert closing Summary
    '--------------------------------------------------------------------------------
    With Range(CM.Cells(LastRow, 2).Offset(8, 0), CM.Cells(LastRow, 2).Offset(8, 6))
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With

    LastRow = LastRow + 6
    With CM.Cells(LastRow, 4)
        .Offset(2, 3).Value = "Total"
        .Offset(3, 1).Value = "Building 1"
        .Offset(4, 1).Value = "Building 2"
        .Offset(5, 1).Value = "Building 3"
        .Offset(6, 1).Value = "Building 4"
        .Offset(7, 1).Value = "Total all Buildings"
    End With
    With Range(CM.Cells(LastRow, 4).Offset(2, 1), CM.Cells(LastRow, 4).Offset(2, 3))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = True
    End With
    Range(CM.Cells(LastRow, 2).Offset(3, 0), CM.Cells(LastRow, 2).Offset(6, 0)).Font.Bold = True
    For i = 1 To 4
        With CM.Cells(LastRow, 4)
            .Offset(2 + i, 3).Value = Sumbldg(i - 1)
            .Offset(2 + i, 3).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
       
        End With
    Next i
    With CM.Cells(LastRow, 4)
            .Offset(7, 3).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
            .Offset(7, 3).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
    End With
    With Range(CM.Cells(LastRow, 2).Offset(8, 0), CM.Cells(LastRow, 2).Offset(8, 6))
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With

Any help to add this final part in would be greatly appreciated.
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Based on just a quick look at this lengthy code, don't you simply need to split your running total BldgSubTot into two?

I'm guessing that labour costs are anything in Worksheets("Labour Cost"), in which case, perhaps something like ...

VBA Code: 
Dim BldgSubTot(1 To 2) As Double

For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
   j = 1    'Materials
   If Sh.Name = "Labour Cost" Then j = 2    'Labour
  
   '....
  
   BldgSubTot(j) = BldgSubTot(j) + Round(a(i, R_Q) * a(i, R_P), 2)
          
   '....
 
Upvote 0
StephenCrump said:
Based on just a quick look at this lengthy code, don't you simply need to split your running total BldgSubTot into two?

I'm guessing that labour costs are anything in Worksheets("Labour Cost"), in which case, perhaps something like ...

VBA Code: 
Dim BldgSubTot(1 To 2) As Double

For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
   j = 1    'Materials
   If Sh.Name = "Labour Cost" Then j = 2    'Labour
 
   '....
 
   BldgSubTot(j) = BldgSubTot(j) + Round(a(i, R_Q) * a(i, R_P), 2)
         
   '....
Click to expand...
Hi, That is correct. I am wanting to split the subtotal into Materials Cost, Labour Cost and then have a grand total below that.

Furthermore, where in the VBA Code should this be placed.
 
Upvote 0
If my assumption is correct (it's only a guess!) you can:

VBA Code: 
'1. Replace
Dim BldgSubTot As Double
'With
Dim BldgSubTot(1 To 2) As Double
 
'2. Replace
For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
'With
For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
    j = 1    'Materials
   If Sh.Name = "Labour Cost" Then j = 2    'Labour
 
'3. Replace
BldgSubTot = BldgSubTot + Round(a(i, R_Q) * a(i, R_P), 2)
'With
BldgSubTot(j) = BldgSubTot(j) + Round(a(i, R_Q) * a(i, R_P), 2)

'4. Replace
With CM.Cells(LastRow, 3)
    .Offset(2, 4).FormulaR1C1 = BldgSubTot
    '..
    .Offset(3, 4).FormulaR1C1 = BldgSubTot
    '..
    .Offset(4, 4).FormulaR1C1 = BldgSubTot
End With
'With
With CM.Cells(LastRow, 3)
    .Offset(2, 4).FormulaR1C1 = BldgSubTot(1)
    '..
    .Offset(3, 4).FormulaR1C1 = BldgSubTot(2)
    '..
    .Offset(4, 4).FormulaR1C1 = BldgSubTot(1) + BldgSubTot(2)
End With
I don't know what this line is meant to do, because you don't use Total:
Total = Total + BldgSubTot

I'm also not sure what this is doing:
Sumbldg(Bldg - 1) = BldgSubTot

and whether you need to split it into two, or maybe just change to Sumbldg(Bldg - 1) = BldgSubTot(1)+BldgSubTot(2) ?
 
Upvote 0
StephenCrump said:
If my assumption is correct (it's only a guess!) you can:

VBA Code: 
'1. Replace
Dim BldgSubTot As Double
'With
Dim BldgSubTot(1 To 2) As Double
 
'2. Replace
For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
'With
For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
    j = 1    'Materials
   If Sh.Name = "Labour Cost" Then j = 2    'Labour
 
'3. Replace
BldgSubTot = BldgSubTot + Round(a(i, R_Q) * a(i, R_P), 2)
'With
BldgSubTot(j) = BldgSubTot(j) + Round(a(i, R_Q) * a(i, R_P), 2)

'4. Replace
With CM.Cells(LastRow, 3)
    .Offset(2, 4).FormulaR1C1 = BldgSubTot
    '..
    .Offset(3, 4).FormulaR1C1 = BldgSubTot
    '..
    .Offset(4, 4).FormulaR1C1 = BldgSubTot
End With
'With
With CM.Cells(LastRow, 3)
    .Offset(2, 4).FormulaR1C1 = BldgSubTot(1)
    '..
    .Offset(3, 4).FormulaR1C1 = BldgSubTot(2)
    '..
    .Offset(4, 4).FormulaR1C1 = BldgSubTot(1) + BldgSubTot(2)
End With
I don't know what this line is meant to do, because you don't use Total:
Total = Total + BldgSubTot

I'm also not sure what this is doing:
Sumbldg(Bldg - 1) = BldgSubTot

and whether you need to split it into two, or maybe just change to Sumbldg(Bldg - 1) = BldgSubTot(1)+BldgSubTot(2) ?
Click to expand...
Code: 
Sub Fill_Customer_Material()
  Dim a, Sh, Sumbldg As Variant
  Dim i, x, z, Bldg, R_Id, R_Desc, R_P, R_Q, LastRow, HeaderCnt As Long
  Dim BldgSubTot(1 To 2) As Double
  Dim CM As Worksheet
  Dim MatRng As String
  Dim Qty As Variant
 
 
 
  Set CM = Sheets("Customer Materials Sheet")
  HeaderCnt = 0
  Sumbldg = Array(0#, 0#, 0#, 0#)
  With CM.Range("AA1:AD5")
    Qty = .Value
  End With
 
  For Bldg = 1 To 4
        LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
        
      For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
            j = 1    'Materials
             If Sh.Name = "Labour Cost" Then j = 2    'Labour
            Select Case Sheets(Sh).Name
                Case Is = "ISP"
                    MatRng = "A3:O106"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 1
                Case Is = "OSP"
                    MatRng = "A3:P113"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 12
                    R_Q = 6 + Bldg
                    z = 2
                Case Is = "Electrical"
                    MatRng = "A3:O51"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 3
                Case Is = "Civils"
                    MatRng = "A3:O101"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 4
                Case Is = "Specials"
                    MatRng = "B3:O19"
                    R_Id = 1
                    R_Desc = 2
                    R_P = 8
                    R_Q = 2 + Bldg
                    z = 5
                 Case Is = "Labour Cost"
                    MatRng = "A3:O13"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 5
            End Select
            
            With Sheets(Sh).Range(MatRng)
                '--------------------------------------------------------------------------------
                'Check if column building qty has any values
                '--------------------------------------------------------------------------------
                Total = 0
                Ctrl = 0
                a = .Value
                For i = 1 To UBound(a)
                    If Len(a(i, R_Q)) > 0 And IsNumeric(a(i, R_Q)) Then
                        If a(i, R_Q) <> 0 Then
                            Ctrl = Ctrl + 1

                        End If
                    End If
                Next i
                                      
                Qty(z, Bldg) = Ctrl
                
    
                If Qty(z, Bldg) > 0 And IsNumeric(Qty(z, Bldg)) Then
                
                    '--------------------------------------------------------------------------------
                    'check if there's already a top header placed and if not Insert and format
                    '--------------------------------------------------------------------------------
                    If (CM.Cells(LastRow, 3).Value = "Job Description" And HeaderCnt = 0) Or (Cells(LastRow, 5).Value = "TOTAL" And HeaderCnt = 0) Then
                        With CM.Cells(LastRow, 3)
                            .Offset(3, 0).Value = "Materials List - Building: " & Bldg
                            .Offset(4, 0).Value = "Item Id"
                            .Offset(4, 1).Value = "Description"
                            .Offset(4, 2).Value = "Price"
                            .Offset(4, 3).Value = "Qty"
                            .Offset(4, 4).Value = "Total"
                        End With
                        With Range(CM.Cells(LastRow, 3).Offset(3, 0), CM.Cells(LastRow, 3).Offset(3, 4))
                                .Interior.Pattern = xlSolid
                                .Interior.PatternColorIndex = xlAutomatic
                                .Interior.Color = 15773696
                                .Interior.TintAndShade = 0
                                .Interior.PatternTintAndShade = 0
                                .Font.Size = 14
                                .Font.Bold = True
                                .Borders(xlDiagonalDown).LineStyle = xlNone
                                .Borders(xlDiagonalUp).LineStyle = xlNone
                                .BorderAround ColorIndex:=0, Weight:=xlThin
                                .Merge
                                .HorizontalAlignment = xlCenter
                        End With
                        With Range(CM.Cells(LastRow, 3).Offset(4, 0), CM.Cells(LastRow, 3).Offset(4, 4))
                                .Font.Size = 12
                                .Font.Bold = True
                                .Borders(xlDiagonalDown).LineStyle = xlNone
                                .Borders(xlDiagonalUp).LineStyle = xlNone
                                .BorderAround ColorIndex:=0, Weight:=xlThin
                                .Borders(xlInsideVertical).LineStyle = xlContinuous
                                .Borders(xlInsideVertical).ColorIndex = 0
                                .Borders(xlInsideVertical).TintAndShade = 0
                                .Borders(xlInsideVertical).Weight = xlThin
                                .HorizontalAlignment = xlCenter
                        End With
                        HeaderCnt = 1
                    End If
                    
                    '--------------------------------------------------------------------------------
                    'Insert and Format Line with Section
                    '--------------------------------------------------------------------------------
                    LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
                    If Cells(LastRow, 5).Value = "Total" Then
                        LastRow = LastRow + 1
                    End If
                    CM.Cells(LastRow, 3).Offset(1, 0).Value = Sheets(Sh).Name
                    With CM.Range(Cells(LastRow, 3).Offset(1, 0), Cells(LastRow, 3).Offset(1, 4))
                        .Interior.Pattern = xlSolid
                        .Interior.PatternColorIndex = xlAutomatic
                        .Interior.ThemeColor = xlThemeColorAccent5
                        .Interior.TintAndShade = 0.599993896298105
                        .Interior.PatternTintAndShade = 0
                        .Borders(xlDiagonalDown).LineStyle = xlNone
                        .Borders(xlDiagonalUp).LineStyle = xlNone
                        .BorderAround ColorIndex:=0, Weight:=xlThin
                    End With
    
                    '--------------------------------------------------------------------------------
                    'Fill Material Master with lines where Qty > 0 for the building involved
                    '--------------------------------------------------------------------------------
                    For i = 1 To UBound(a)
                        If Len(a(i, R_Q)) > 0 And IsNumeric(a(i, R_Q)) Then
                            If a(i, R_Q) > 0 Then
                                LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
                                '--------------------------------------------------------------------------------
                                'Next Section insert the Values
                                '--------------------------------------------------------------------------------
                                With CM.Cells(LastRow, 3)
                                    .Offset(1, 0).Value = a(i, R_Id) 'Item ID
                                    .Offset(1, 1).Value = a(i, R_Desc) 'Description
                                    .Offset(1, 2).Value = Round(a(i, R_P), 2) 'price
                                    .Offset(1, 3).Value = Round(a(i, R_Q), 2) 'Qty
                                    .Offset(1, 4).Value = Round(a(i, R_Q) * a(i, R_P), 2) 'total
                                End With
                                '--------------------------------------------------------------------------------
                                'Next Section insert the formatting
                                '--------------------------------------------------------------------------------
                                CM.Cells(LastRow, 3).Offset(1, 2).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                                CM.Cells(LastRow, 3).Offset(1, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                                With CM.Range(Cells(LastRow, 3).Offset(1, 0), Cells(LastRow, 3).Offset(1, 4))
                                    .Borders(xlDiagonalDown).LineStyle = xlNone
                                    .Borders(xlDiagonalUp).LineStyle = xlNone
                                    .BorderAround ColorIndex:=0, Weight:=xlThin
                                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                                    .Borders(xlInsideVertical).ColorIndex = 0
                                    .Borders(xlInsideVertical).TintAndShade = 0
                                    .Borders(xlInsideVertical).Weight = xlThin
                                End With
                                BldgSubTot(j) = BldgSubTot(j) + Round(a(i, R_Q) * a(i, R_P), 2)
                            End If
                        End If
                    Next i
                End If
            End With
            LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
            x = x + Qty(z, Bldg)
        Next Sh
        Debug.Print Sh
        
            '--------------------------------------------------------------------------------
            'Next Section insert the footer & calculation
            '--------------------------------------------------------------------------------
        
        
        
        If x > 0 Then
            With CM.Cells(LastRow, 3)
                .Offset(2, 2).Value = "Materials Total"
                .Offset(2, 4).FormulaR1C1 = BldgSubTot(1)
                .Offset(2, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                .Offset(3, 2).Value = "Labour Total"
                .Offset(3, 4).FormulaR1C1 = BldgSubTot(2)
                .Offset(3, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                .Offset(4, 2).Value = "Total"
                .Offset(4, 4).FormulaR1C1 = BldgSubTot(1) + BldgSubTot(2)
                .Offset(4, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
            End With
                        
            '--------------------------------------------------------------------------------
            'Next Section applies Double Thick line Above Total
            '--------------------------------------------------------------------------------
            With Range(CM.Cells(LastRow, 3).Offset(5, 4), CM.Cells(LastRow, 3).Offset(5, 4))
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeBottom).LineStyle = xlNone
                .Borders(xlEdgeRight).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlDouble
                .Borders(xlEdgeTop).ColorIndex = xlAutomatic
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThick
            End With
            HeaderCnt = 0
            Sumbldg(Bldg - 1) = BldgSubTot(1) + BldgSubTot(2)

            Total = Total + BldgSubTot(1) + BldgSubTot(2)
            BldgSubTot(1) = 0
            BldgSubTot(2) = 0
            End If
    Next Bldg
    
    '--------------------------------------------------------------------------------
    'Next Section insert closing Summary
    '--------------------------------------------------------------------------------
    With Range(CM.Cells(LastRow, 2).Offset(8, 0), CM.Cells(LastRow, 2).Offset(8, 6))
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With

    LastRow = LastRow + 6
    With CM.Cells(LastRow, 4)
        .Offset(2, 3).Value = "Total"
        .Offset(3, 1).Value = "Building 1"
        .Offset(4, 1).Value = "Building 2"
        .Offset(5, 1).Value = "Building 3"
        .Offset(6, 1).Value = "Building 4"
        .Offset(7, 1).Value = "Total all Buildings"
    End With
    With Range(CM.Cells(LastRow, 4).Offset(2, 1), CM.Cells(LastRow, 4).Offset(2, 3))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = True
    End With
    Range(CM.Cells(LastRow, 2).Offset(3, 0), CM.Cells(LastRow, 2).Offset(6, 0)).Font.Bold = True
    For i = 1 To 4
        With CM.Cells(LastRow, 4)
            .Offset(2 + i, 3).Value = Sumbldg(i - 1)
            .Offset(2 + i, 3).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
        
        End With
    Next i
    With CM.Cells(LastRow, 4)
            .Offset(7, 3).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
            .Offset(7, 3).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
    End With
    With Range(CM.Cells(LastRow, 2).Offset(8, 0), CM.Cells(LastRow, 2).Offset(8, 6))
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
    
    
    

End Sub

On this Line (If Sh.Name = "Labour Cost" Then j = 2 'Labour), I am being faced with this error: run-time error '424': Object Required

Do you know what this means?
 
Upvote 0
Sorry, misread your code. That should be:

If Sh = "Labour Cost" Then j = 2
 
Upvote 0
StephenCrump said:
Sorry, misread your code. That should be:

If Sh = "Labour Cost" Then j = 2
Click to expand...
VBA Code: 
Sub Fill_Customer_Material()
  Dim a, Sh, Sumbldg As Variant
  Dim i, x, z, Bldg, R_Id, R_Desc, R_P, R_Q, LastRow, HeaderCnt As Long
  Dim BldgSubTot(1 To 2) As Double
  Dim CM As Worksheet
  Dim MatRng As String
  Dim Qty As Variant
 
 
 
  Set CM = Sheets("Customer Materials Sheet")
  HeaderCnt = 0
  Sumbldg = Array(0#, 0#, 0#, 0#)
  With CM.Range("AA1:AD5")
    Qty = .Value
  End With
 
  For Bldg = 1 To 4
        LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
        
      For Each Sh In Array("ISP", "OSP", "Electrical", "Patch Leads", "Civils", "Specials", "Labour Cost")
            If Sh = Materials Then j = 1
             If Sh = "Labour Cost" Then j = 2
            Select Case Sheets(Sh).Name
                Case Is = "ISP"
                    MatRng = "A3:O106"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 1
                Case Is = "OSP"
                    MatRng = "A3:P113"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 12
                    R_Q = 6 + Bldg
                    z = 2
                Case Is = "Electrical"
                    MatRng = "A3:O51"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 3
                Case Is = "Civils"
                    MatRng = "A3:O101"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 4
                Case Is = "Specials"
                    MatRng = "B3:O19"
                    R_Id = 1
                    R_Desc = 2
                    R_P = 8
                    R_Q = 2 + Bldg
                    z = 5
                 Case Is = "Labour Cost"
                    MatRng = "A3:O13"
                    R_Id = 1
                    R_Desc = 3
                    R_P = 11
                    R_Q = 5 + Bldg
                    z = 5
            End Select
            
            With Sheets(Sh).Range(MatRng)
                '--------------------------------------------------------------------------------
                'Check if column building qty has any values
                '--------------------------------------------------------------------------------
                Total = 0
                Ctrl = 0
                a = .Value
                For i = 1 To UBound(a)
                    If Len(a(i, R_Q)) > 0 And IsNumeric(a(i, R_Q)) Then
                        If a(i, R_Q) <> 0 Then
                            Ctrl = Ctrl + 1

                        End If
                    End If
                Next i
                                      
                Qty(z, Bldg) = Ctrl
                
    
                If Qty(z, Bldg) > 0 And IsNumeric(Qty(z, Bldg)) Then
                
                    '--------------------------------------------------------------------------------
                    'check if there's already a top header placed and if not Insert and format
                    '--------------------------------------------------------------------------------
                    If (CM.Cells(LastRow, 3).Value = "Job Description" And HeaderCnt = 0) Or (Cells(LastRow, 5).Value = "TOTAL" And HeaderCnt = 0) Then
                        With CM.Cells(LastRow, 3)
                            .Offset(3, 0).Value = "Materials List - Building: " & Bldg
                            .Offset(4, 0).Value = "Item Id"
                            .Offset(4, 1).Value = "Description"
                            .Offset(4, 2).Value = "Price"
                            .Offset(4, 3).Value = "Qty"
                            .Offset(4, 4).Value = "Total"
                        End With
                        With Range(CM.Cells(LastRow, 3).Offset(3, 0), CM.Cells(LastRow, 3).Offset(3, 4))
                                .Interior.Pattern = xlSolid
                                .Interior.PatternColorIndex = xlAutomatic
                                .Interior.Color = 15773696
                                .Interior.TintAndShade = 0
                                .Interior.PatternTintAndShade = 0
                                .Font.Size = 14
                                .Font.Bold = True
                                .Borders(xlDiagonalDown).LineStyle = xlNone
                                .Borders(xlDiagonalUp).LineStyle = xlNone
                                .BorderAround ColorIndex:=0, Weight:=xlThin
                                .Merge
                                .HorizontalAlignment = xlCenter
                        End With
                        With Range(CM.Cells(LastRow, 3).Offset(4, 0), CM.Cells(LastRow, 3).Offset(4, 4))
                                .Font.Size = 12
                                .Font.Bold = True
                                .Borders(xlDiagonalDown).LineStyle = xlNone
                                .Borders(xlDiagonalUp).LineStyle = xlNone
                                .BorderAround ColorIndex:=0, Weight:=xlThin
                                .Borders(xlInsideVertical).LineStyle = xlContinuous
                                .Borders(xlInsideVertical).ColorIndex = 0
                                .Borders(xlInsideVertical).TintAndShade = 0
                                .Borders(xlInsideVertical).Weight = xlThin
                                .HorizontalAlignment = xlCenter
                        End With
                        HeaderCnt = 1
                    End If
                    
                    '--------------------------------------------------------------------------------
                    'Insert and Format Line with Section
                    '--------------------------------------------------------------------------------
                    LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
                    If Cells(LastRow, 5).Value = "Total" Then
                        LastRow = LastRow + 1
                    End If
                    CM.Cells(LastRow, 3).Offset(1, 0).Value = Sheets(Sh).Name
                    With CM.Range(Cells(LastRow, 3).Offset(1, 0), Cells(LastRow, 3).Offset(1, 4))
                        .Interior.Pattern = xlSolid
                        .Interior.PatternColorIndex = xlAutomatic
                        .Interior.ThemeColor = xlThemeColorAccent5
                        .Interior.TintAndShade = 0.599993896298105
                        .Interior.PatternTintAndShade = 0
                        .Borders(xlDiagonalDown).LineStyle = xlNone
                        .Borders(xlDiagonalUp).LineStyle = xlNone
                        .BorderAround ColorIndex:=0, Weight:=xlThin
                    End With
    
                    '--------------------------------------------------------------------------------
                    'Fill Material Master with lines where Qty > 0 for the building involved
                    '--------------------------------------------------------------------------------
                    For i = 1 To UBound(a)
                        If Len(a(i, R_Q)) > 0 And IsNumeric(a(i, R_Q)) Then
                            If a(i, R_Q) > 0 Then
                                LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
                                '--------------------------------------------------------------------------------
                                'Next Section insert the Values
                                '--------------------------------------------------------------------------------
                                With CM.Cells(LastRow, 3)
                                    .Offset(1, 0).Value = a(i, R_Id) 'Item ID
                                    .Offset(1, 1).Value = a(i, R_Desc) 'Description
                                    .Offset(1, 2).Value = Round(a(i, R_P), 2) 'price
                                    .Offset(1, 3).Value = Round(a(i, R_Q), 2) 'Qty
                                    .Offset(1, 4).Value = Round(a(i, R_Q) * a(i, R_P), 2) 'total
                                End With
                                '--------------------------------------------------------------------------------
                                'Next Section insert the formatting
                                '--------------------------------------------------------------------------------
                                CM.Cells(LastRow, 3).Offset(1, 2).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                                CM.Cells(LastRow, 3).Offset(1, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                                With CM.Range(Cells(LastRow, 3).Offset(1, 0), Cells(LastRow, 3).Offset(1, 4))
                                    .Borders(xlDiagonalDown).LineStyle = xlNone
                                    .Borders(xlDiagonalUp).LineStyle = xlNone
                                    .BorderAround ColorIndex:=0, Weight:=xlThin
                                    .Borders(xlInsideVertical).LineStyle = xlContinuous
                                    .Borders(xlInsideVertical).ColorIndex = 0
                                    .Borders(xlInsideVertical).TintAndShade = 0
                                    .Borders(xlInsideVertical).Weight = xlThin
                                End With
                                BldgSubTot(j) = BldgSubTot(j) + Round(a(i, R_Q) * a(i, R_P), 2)
                            End If
                        End If
                    Next i
                End If
            End With
            LastRow = WorksheetFunction.Max(CM.Cells(Rows.Count, 3).End(xlUp).Row, CM.Cells(Rows.Count, 7).End(xlUp).Row)
            x = x + Qty(z, Bldg)
        Next Sh
        Debug.Print Sh
        
            '--------------------------------------------------------------------------------
            'Next Section insert the footer & calculation
            '--------------------------------------------------------------------------------
        
        
        
        If x > 0 Then
            With CM.Cells(LastRow, 3)
                .Offset(2, 2).Value = "Materials Total"
                .Offset(2, 4).FormulaR1C1 = BldgSubTot(1)
                .Offset(2, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                .Offset(3, 2).Value = "Labour Total"
                .Offset(3, 4).FormulaR1C1 = BldgSubTot(2)
                .Offset(3, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
                .Offset(4, 2).Value = "Total"
                .Offset(4, 4).FormulaR1C1 = BldgSubTot(1) + BldgSubTot(2)
                .Offset(4, 4).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
            End With
                        
            '--------------------------------------------------------------------------------
            'Next Section applies Double Thick line Above Total
            '--------------------------------------------------------------------------------
            With Range(CM.Cells(LastRow, 3).Offset(5, 4), CM.Cells(LastRow, 3).Offset(5, 4))
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
                .Borders(xlEdgeLeft).LineStyle = xlNone
                .Borders(xlEdgeBottom).LineStyle = xlNone
                .Borders(xlEdgeRight).LineStyle = xlNone
                .Borders(xlInsideVertical).LineStyle = xlNone
                .Borders(xlInsideHorizontal).LineStyle = xlNone
                .Borders(xlEdgeTop).LineStyle = xlDouble
                .Borders(xlEdgeTop).ColorIndex = xlAutomatic
                .Borders(xlEdgeTop).TintAndShade = 0
                .Borders(xlEdgeTop).Weight = xlThick
            End With
            HeaderCnt = 0
            Sumbldg(Bldg - 1) = BldgSubTot(1) + BldgSubTot(2)

            Total = Total + BldgSubTot(1) + BldgSubTot(2)
            BldgSubTot(1) = 0
            BldgSubTot(2) = 0
            End If
    Next Bldg
    
    '--------------------------------------------------------------------------------
    'Next Section insert closing Summary
    '--------------------------------------------------------------------------------
    With Range(CM.Cells(LastRow, 2).Offset(8, 0), CM.Cells(LastRow, 2).Offset(8, 6))
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With

    LastRow = LastRow + 6
    With CM.Cells(LastRow, 4)
        .Offset(2, 3).Value = "Total"
        .Offset(3, 1).Value = "Building 1"
        .Offset(4, 1).Value = "Building 2"
        .Offset(5, 1).Value = "Building 3"
        .Offset(6, 1).Value = "Building 4"
        .Offset(7, 1).Value = "Total all Buildings"
    End With
    With Range(CM.Cells(LastRow, 4).Offset(2, 1), CM.Cells(LastRow, 4).Offset(2, 3))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Font.Bold = True
    End With
    Range(CM.Cells(LastRow, 2).Offset(3, 0), CM.Cells(LastRow, 2).Offset(6, 0)).Font.Bold = True
    For i = 1 To 4
        With CM.Cells(LastRow, 4)
            .Offset(2 + i, 3).Value = Sumbldg(i - 1)
            .Offset(2 + i, 3).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
        
        End With
    Next i
    With CM.Cells(LastRow, 4)
            .Offset(7, 3).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
            .Offset(7, 3).NumberFormat = "_-[$£-en-GB]* #,##0.00_-;-[$£-en-GB]* #,##0.00_-;_-[$£-en-GB]* ""-""??_-;_-@_-"
    End With
    With Range(CM.Cells(LastRow, 2).Offset(8, 0), CM.Cells(LastRow, 2).Offset(8, 6))
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlMedium
    End With
    
    
    

End Sub

I feel like it is almost there. Just getting this error when at the this:
1631186560949.png


Getting the error of Subscript out of range when it is trying to complete the action.
 
Upvote 0
We've declared:
Code: 
Dim BldgSubTot(1 To 2) As Double
So the error means that somehow we have a value of j other than 1 or 2.

Here's your problem:
VBA Code: 
If Sh = materials Then j = 1
If Sh = "Labour Cost" Then j = 2

Based on your code, VBA assumes there is a variable called materials. As this hasn't been assigned a value, neither of your two tests will be TRUE, hence j will return the default value 0, and hence you'll get a Subscript out of range error. I strongly recommend you use Option Explicit, which will force you to declare all your variables. This would have flagged the problem with a Compile error: Variable not defined. This will save you lots of time with similar coding problems which would otherwise drive you nuts trying to debug.

Here's another way I could have expressed my version (again based on my assumption that anything in sheets other than "Labour Cost" is materials):
Code: 
j = IIf(Sh = "Labour Cost", 2, 1)
Perhaps that's clearer?
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
600
RoryA
RoryA
P
  • Question Question
Rationalise Code
Replies
1
Views
305
mumps
mumps
M
  • Question Question
Hiding lay-out with a macro
Replies
2
Views
356
MIBO
M
J
  • Question Question
VBA Code to Add Rows is slowing down
Replies
5
Views
1K
JayB0730
J
J
  • Question Question
Issue with Macros and renaming files
Replies
6
Views
1K
kevin9999
K

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top