PDA

View Full Version : [SOLVED] Apply different format to each column of selection



Dave T
06-01-2016, 04:39 PM
Hello All,

I have asked a longer version of this question in another forum (http://www.msofficeforums.com/excel-programming/31352-format-range-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
06-01-2016, 06:46 PM
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
06-01-2016, 07:13 PM
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
06-01-2016, 08:54 PM
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
06-02-2016, 12:11 AM
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"