Apply different format to each column of selection

[Dave T]

Hello All,

I have asked a longer version of this question in another forum (http://www.msofficeforums.com/excel-...nge-cells.html), but as I have had no responses so far I thought I would ask for a much simpler solution.

I have a workbook which is created as an output from another program. I use a macro that creates a new worksheet and then copies specific columns and rearranges them in the new worksheet.
I also use the following macro to format the new worksheet, but it feels a bit long winded to me. The macro I am using keeps repeating With Worksheets("Sheet2") for the formatting of each column and I wonder if this is necessary.

How can I just select a range of cells to be formatted that are in column A and the macro formats this selection, then formats the adjacent column (B) and then the next (C, D, E and so on).
I have several ranges of data each with a different header so I am after selected cells and not .Range("A3:A" & LASTROW).Select.

Sub FormatColumns()

  Dim LASTROW As Long

 With Worksheets("Sheet2")
    LASTROW = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A3:A" & LASTROW).Select
    With Selection.Font
      .Name = "Calibri"    'Change font type here
      .Bold = False
      .Size = 10    'Change font size here
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ThemeColor = xlThemeColorLight1
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
    With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .WrapText = False
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      .ColumnWidth = 6
      .Rows.AutoFit
    End With
  End With

  With Worksheets("Sheet2")
    LASTROW = .Cells(Rows.Count, "B").End(xlUp).Row
    .Range("B3:B" & LASTROW).Select
    With Selection.Font
      .Name = "Calibri"
      .Bold = False
      .Size = 8
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ThemeColor = xlThemeColorLight1
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
    With Selection
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlCenter
      .WrapText = True
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
      .ColumnWidth = 10
      .Rows.AutoFit
    End With
  End With
End Sub

If someone has a better idea how to format columns adjacent of the selected cells in column A it would be greatly appreciated.
Hopefully I just need a macro that shows how to format columns A, B and C and I can add the extra columns myself.

Regards,
Dave T

[SamT]

Avoid Selection whenever possible.
First set the entire used Range, Offset by 2 rows, then only change individual columns as needed.
Don't bother setting unused properties to default values

Sub VBAX_SamT_FormatColumns() 
    
    'UnComment after testing
    'Application.ScreenUpdating = False 

    With Worksheets("Sheet2") 
        With .UsedRange.Offset(2) 
            With .Font 
            .Name = "Calibri" 'Change font type here
            .Size = 10 'Change font size here
            .ThemeColor = xlThemeColorLight1 
             End With 'UsedRange Font

            .HorizontalAlignment = xlCenter 
            .VerticalAlignment = xlCenter 
            .ColumnWidth = 6 
           End With 'UsedRange
         
       With Intersect(.Range("B:B"), .UsedRange).Offset(2) 
          .Font.Size = 8 

          .HorizontalAlignment = xlLeft 
          .WrapText = True 
          .ColumnWidth = 10 
        End With 'column B

  'Example, formatted same as A except column width
       With Intersect(.Range("C:C"), .UsedRange).Offset(2) 
        .ColumnWidth = 10
End With 'column C 'This section could be a one liner.

     .UsedRange.Offset(2).Rows.AutoFit 'Entire Used range except first two rows
    End With 'sheet
    Application.ScreenUpdating = True
End Sub

This could be shortened even more, but I did it this way for clarity of purpose.

[SamT]

Shorter version

Sub VBAX_SamT_FormatColumns() 
     
     'UnComment after testing
     'Application.ScreenUpdating = False
     
    With Worksheets("Sheet2").UsedRange.Offset(2) 
            With .Font 
                .Name = "Calibri" 'Change font type here
                .Size = 10 'Change font size here
                .ThemeColor = xlThemeColorLight1 
            End With 'UsedRange Font
             
            .HorizontalAlignment = xlCenter 
            .VerticalAlignment = xlCenter 
            .ColumnWidth = 6 

        With .Columns(2) 
            .Font.Size = 8 
             
            .HorizontalAlignment = xlLeft 
            .WrapText = True 
            .ColumnWidth = 10 
        End With 'column B
         
         'Example, Column cformatted same as A except column width
        .columns(3).ColumnWidth = 10 
         
        .Rows.AutoFit 'Entire Used range except first two rows
    End With 'sheet Used Range
    Application.ScreenUpdating = True 
End Sub

Note that because I didn't Resize after Offsetting, this will extend the actual Used Range by 2 rows. It will only be an issue if you run this code on the same sheet many times.

[Dave T]

Thank you very much Sam for pointing me in the right direction.

I have made some slight changes to what you posted that suit my needs

Sub VBAX_SamT_FormatColumns_V2()
'http://www.vbaexpress.com/forum/showthread.php?56213-Apply-different-format-to-each-column-of-selection     'UnComment after testing
     Application.ScreenUpdating = False
     
    With Worksheets("Sheet1")
        With ActiveCell.CurrentRegion.Offset(1)
            With .Font
                .Name = "Calibri" 'Change font type here
                .Size = 10 'Change font size here
                .ThemeColor = xlThemeColorLight1
            End With 'UsedRange Font
             
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .ColumnWidth = 6
        End With 'UsedRange
         
        With Intersect(.Range("B:B"), ActiveCell.CurrentRegion).Offset(1)
            .Font.Size = 8
             
            .HorizontalAlignment = xlLeft
            .WrapText = True
            .ColumnWidth = 10
        End With 'column B
         
         'Example, formatted same as A except column width
        With Intersect(.Range("C:C"), ActiveCell.CurrentRegion).Offset(1)
            .ColumnWidth = 10
        End With 'Column C 'This section could be a one liner.
         
        ActiveCell.CurrentRegion.Offset(1).Rows.AutoFit 'Entire Used range except first row
    End With 'sheet
    Application.ScreenUpdating = True
    
End Sub

I really appreciate your help.

Regards,
Dave T

[snb]

you'd better use a 'smart' table. (in VBA: Listobject).

You can define your own 'style' that can be applied to a range:

   ListObjects(1).DataBodyRange.Style = "snb"