Consulting

Results 1 to 9 of 9

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

  1. #1
    VBAX Regular
    Joined
    Apr 2024
    Location
    UK
    Posts
    20
    Location

    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


    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

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,785
    Location
    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


    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

     
    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")
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,924
    …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).:
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    VBAX Regular
    Joined
    Apr 2024
    Location
    UK
    Posts
    20
    Location
    Quote Originally Posted by Paul_Hossler View Post
    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 View Post
    …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.

  5. #5
    snb
    Guest
    Why not using Excel's builtin methods ?

    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.

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,785
    Location
    Quote Originally Posted by snb View Post
    Why not using Excel's builtin methods ?

    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", ...
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,232
    Location
    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.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  8. #8
    Administrator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,254
    Location
    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:
    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:
    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:
    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)
    Attached Files Attached Files
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2408, Build 17928.20080

  9. #9
    VBAX Regular
    Joined
    Apr 2024
    Location
    UK
    Posts
    20
    Location
    Thank you everyone for your kind suggestions and they are very much appreciated.

    I will try them all out in turn.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •