Formatting each sheet in new workbooks with vba code

[dpaton05]

I have code that creates a workbook if it doesn't exist. I then want to format the worksheets but with my code I get the error, object doesn't support this property or method. The line that is highlighted is in SetupSheets:

For Each Worksheet In ThisWorkbook

Sub AddYP()
Application.DisplayAlerts = False
Dim newyp As String
    newyp = Tracker.Cells(5, 4)
    YP.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = newyp
        Call CreateWB(newyp)
    ThisWorkbook.Names.Add Name:="tblYPNames", _
    RefersTo:=Range("tblYPNames").Resize(Range("tblYPNames").Rows.Count + 1)
        Tracker.cboYP.ListFillRange = "tblYPNames"
        Tracker.cboDeleteYP.ListFillRange = "tblYPNames"
Application.DisplayAlerts = True
End Sub


Sub CreateWB(newyp As String)
Dim V
        CheckFolderExists
        Workbooks.Add.SaveAs ThisWorkbook.Path & "\Young People\" & newyp, 52
    For Each V In Split("7 8 9 10 11 12 1 2 3 4 5 6")
        Sheets.Add(, Sheets(Sheets.Count)).Name = MonthName(V)
    Next
    Call SetupSheets
    Sheets("sheet1").Delete
ActiveWorkbook.Close savechanges:=True
Tracker.Cells(5, 4).Clear
End Sub

Sub SetupSheets()
Dim Worksheet As Worksheet
    For Each Worksheet In ThisWorkbook
        Range("A1").Value = "Date"
        Range("A2").Value = "GL Code"
        Range("A3").Value = "Supplier"
        Range("A4").Value = "Amount"
        Range("A5").Value = "Comments"
        With Rows(1)
            .Font.Bold = True
            .Interior.ColorIndex = 15
        End With
        
    Next
End Sub

 

[jolivanes]

Using this

With ws.Rows(3)
.Font.Bold = True
.Interior.ColorIndex = 15
 End With

You are formatting 16,000 + Cells.
Getting into that habit is a sure way to end up with bloated workbooks.

 

[dpaton05]

Using this

With ws.Rows(3)
.Font.Bold = True
.Interior.ColorIndex = 15
 End With

You are formatting 16,000 + Cells.
Getting into that habit is a sure way to end up with bloated workbooks.

Thanks, I will change it to format only the headers.

 

[dpaton05]

Using this

With ws.Rows(3)
.Font.Bold = True
.Interior.ColorIndex = 15
 End With

You are formatting 16,000 + Cells.
Getting into that habit is a sure way to end up with bloated workbooks.

Is this better?

With ws.Rows("A3:A" & Range("A3").End(xlToRight))

 

[dpaton05]

I finish work at 2 and I want to get this working before I leave. Do you know the answer Michael as with this, I get a type mismatch?

 

[Michael M]

ws.Cells(3, Columns.Count).End(xlToLeft).Column

 

[dpaton05]

I am trying to make the headers bold and a certain highlight, not the entire row, what have I done wrong?

Sub SetupSheets()
Dim ws As Worksheet
    For Each ws In Worksheets
        With ws
            .Range("A3").Value = "Date"
            .Range("B3").Value = "GL Code"
            .Range("C3").Value = "Supplier"
            .Range("D3").Value = "Amount"
            .Range("E3").Value = "Comments"
            With ws.Cells(3, Columns.Count).End(xlToLeft).Column
                .Font.Bold = True
                .Interior.ColorIndex = 15
            End With
            With .Range("A1")
                .Value = ws.Name
                .Font.Size = 16
            End With
            .Range("A:A,B:B,D:D").ColumnWidth = 15
            .Range("C:C").ColumnWidth = 30
            .Range("E:E").ColumnWidth = 60
            With .Range("I10")
                .Value = "Monthly Total"
                .Font.Bold = True
                .Font.Size = 16
            End With
            Call SumTotals(ws)
        End With
    Next ws
End Sub

 

[Michael M]

Sub SetupSheets()
Dim ws As Worksheet
    For Each ws In Worksheets
        With ws
            .Range("A3").Value = "Date"
            .Range("B3").Value = "GL Code"
            .Range("C3").Value = "Supplier"
            .Range("D3").Value = "Amount"
            .Range("E3").Value = "Comments"
    lc = .Cells(3, Columns.Count).End(xlToLeft).Column
            With ws.Range(Cells(3, 1), Cells(3, lc))
                .Font.Bold = True
                .Interior.ColorIndex = 15
            End With
            With .Range("A1")
                .Value = ws.Name
                .Font.Size = 16
            End With
            .Range("A:A,B:B,D:D").ColumnWidth = 15
            .Range("C:C").ColumnWidth = 30
            .Range("E:E").ColumnWidth = 60
            With .Range("I10")
                .Value = "Monthly Total"
                .Font.Bold = True
                .Font.Size = 16
            End With
            Call SumTotals(ws)
        End With
    Next ws
End Sub

 

[dpaton05]

That gave me the error method range of object worksheet failed

 

[dpaton05]

With this line highlighted

With ws.Range(Cells(3, 1), Cells(3, lc))

 

[Michael M]

Sub SetupSheets()
Dim ws As Worksheet
    For Each ws In Worksheets
     ws.Activate
            Range("A3").Value = "Date"
            Range("B3").Value = "GL Code"
            Range("C3").Value = "Supplier"
            Range("D3").Value = "Amount"
            Range("E3").Value = "Comments"
    lc = Cells(3, Columns.Count).End(xlToLeft).Column
            With Range(Cells(3, 1), Cells(3, lc))
                .Font.Bold = True
                .Interior.ColorIndex = 15
            End With
            With Range("A1")
                .Value = ws.Name
                .Font.Size = 16
            End With
            Range("A:A,B:B,D:D").ColumnWidth = 15
            Range("C:C").ColumnWidth = 30
            Range("E:E").ColumnWidth = 60
            With Range("I10")
                .Value = "Monthly Total"
                .Font.Bold = True
                .Font.Size = 16
            End With
           Call SumTotals(ws)
    Next ws
End Sub