Event2020
04-26-2024, 12:21 PM
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
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
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
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