A more simple or efficient way of entering header row text & formatting ?

Hello everyone.

I am using Windows 10 and Excel 2019.

This is my first post here and I hope to learn and maybe, in time, give back.

I use the code below to.
1. Clear all cell contents and formatting
2. Adds the text (value?) for cells A1 to AI
3. Fomats the cells
4. Freezes the top row.

It seems to be a lot of code to do what appears to be something simple.

My question is, is there a more simple or efficient way of writing the VBA code?

Many thanks

Code:

---

Sub TestAddHeader()


    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
       
    End With




'  Makes Sheet5the active sheet
    Sheets("Sheet5").Activate
   
'  Clears all formulas, text and row colours
    Cells.Clear
    Cells.ClearFormats
   


    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Title 1"
   
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Title 2"
   
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Title 3"
   
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Title 4"
   
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Title 5"
   
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Title 6"
   
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Title 7"
   
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Title 8"
   
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Title 9"
   
     
    Range("A1:I1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
   
    '  This applies the top row (Row 1) freeze
    Rows("1:1").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    Range("A2").Select
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
       
    End With
   
    End Sub

---

This is a little more simplified

Usually you do not need to .Select some object to act on it

Just .Borders without an index applies to the outside 4

Code:

---

Option Explicit


Sub TestAddHeader()


    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With




'  Makes Sheet5the active sheet
    With Sheets("Sheet5")
   
'  Clears all formulas, text and row colours
        .Cells.Clear
        .Cells.ClearFormats
   
        .Range("A1").Value = "Title 1"
        .Range("B1").Value = "Title 2"
        .Range("C1").Value = "Title 3"
        .Range("D1").Value = "Title 4"
        .Range("E1").Value = "Title 5"
        .Range("F1").Value = "Title 6"
        .Range("G1").Value = "Title 7"
        .Range("H1").Value = "Title 8"
        .Range("I1").Value = "Title 9"
     
        With .Range("A1:I1")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
   
            With .Font
                .Bold = True
            End With
   
            With .Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.149998474074526
                .PatternTintAndShade = 0
            End With
       
            .Borders.LineStyle = xlContinuous
        End With
   
    .Rows("1:1").Select
   
'  This applies the top row (Row 1) freeze
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With
   
   
    .Range("A2").Select
    End With
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
   
End Sub

---

A less brute force way would be something like

Code:

---


Range("A1").Resize(1, 9).Value = Array("Title 1", "Title 2", "Title 3", "Title 4", "Title 5", "Title 6", "Title 7", "Title 8", "Title 9")

---

…and shorter. Note that .BorderAround doesn't add internal borders (same as your original code). Many things that are recorded by the macro recorder change things that don't need changing because they're already that value/property after .Clear (which also clears formats).:

Code:

---

Sub TestAddHeader()
With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
End With
With Sheets("Sheet5")
  'Clears all formulas, text and row colours **and formats**:
  .Cells.Clear
  With .Range("A1:I1")
    .Value = Array("Title 1", "Title 2", "Title 3", "Title 4", "Title 5", "Title 6", "Title 7", "Title 8", "Title 9")
    .VerticalAlignment = xlCenter
    .Font.Bold = True
    With .Interior
      .Pattern = xlSolid
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = -0.149998474074526
    End With
    .BorderAround xlContinuous, xlMedium
  End With
End With
'  This applies the top row (Row 1) freeze
With ActiveWindow
  .SplitColumn = 0
  .SplitRow = 1
  .FreezePanes = True
End With
With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
End With
End Sub

---

Quote:

---

Originally Posted by Paul_Hossler

This is a little more simplified


Usually you do not need to .Select some object to act on it


Just .Borders without an index applies to the outside 4

---

and

Quote:

---

Originally Posted by p45cal

…and shorter. Note that .BorderAround doesn't add internal borders (same as your original code). Many things that are recorded by the macro recorder change things that don't need changing because they're already that value/property after .Clear (which also clears formats).

---

Thank you Paul and p45cal


Later today I will give both of your suggestions a try.


Thank you again.

Why not using Excel's builtin methods ?

Code:

---

Sub M_snb()
  Cells(1) = "Title 1"
  Cells(1).AutoFill Cells(1).Resize(, 9)
  ListObjects.Add(1, Cells(1).Resize(, 9), , 1).Name = "Table1"
End Sub

---

Macro in the macromodule of the activesheet.

Quote:

---

Originally Posted by snb

Why not using Excel's builtin methods ?

Code:

---

Sub M_snb()
  Cells(1) = "Title 1"
  Cells(1).AutoFill Cells(1).Resize(, 9)
  ListObjects.Add(1, Cells(1).Resize(, 9), , 1).Name = "Table1"
End Sub

---

Macro in the macromodule of the activesheet.

---

FWIW, I assumed that "Title 1" ... "Title 9" were just some placeholders for the question and that the real column headers would be something like "Region", "State", "City", "Street", ...

One of the major issues with snb's code it that he never explains the code. In fact I often wonder whether he actually could explain it. One is always left with the feeling that the code may or may not work. Unfortunately experience has confirmed that snb's code generally fails. For that reason alone I tend to ignore any code provided by snb as rubbish.

If you are simply clearing the cells and adding a formatted header then I would suggest another approach. You could have a hidden sheet that contains the formatted header, this would give you the ability to format and change the header as you wish (manually and visually), without having to edit any VBA. You would then copy the header from the hidden template sheet and paste it into the required sheet. The code would be similar to the below:

Code:

---

Sub Test()
    Dim wsHeader As Worksheet, wsTarget As Worksheet
   
    Set wsHeader = Sheets("Header Template")
    Set wsTarget = Sheets("Sheet5")
   
    With wsTarget
        .Activate
        .UsedRange.Clear
        wsHeader.Rows(1).Copy .Rows(1)
        .Rows(2).Activate
    End With
    ActiveWindow.FreezePanes = True
End Sub

---

On another note:
If it is always 'Sheet5' that you are updating the the frozen row at the top will remain frozen even after the cells have been cleared. This means you would not need to repeat the steps to freeze the top row each time, you could freeze it once manually and then forget about it.
The code could then be shortened to:

Code:

---

Sub Test1()
    Dim wsHeader As Worksheet, wsTarget As Worksheet
   
    Set wsHeader = Sheets("Header Template")
    Set wsTarget = Sheets("Sheet5")
   
    With wsTarget
        .UsedRange.Clear
        wsHeader.Rows(1).Copy .Rows(1)
    End With
End Sub

---

Or even shorter:

Code:

---

Sub Test2()
    Sheets("Sheet5").UsedRange.Clear
    Sheets("Header Template").Rows(1).Copy Sheets("Sheet5").Rows(1)
End Sub

---

See attached file (remember the 'Header Template' sheet can be hidden)

Thank you everyone for your kind suggestions and they are very much appreciated.

I will try them all out in turn.