#1
|
|||
|
|||
Format a range of cells
Hello All,
I have been using the following macro to quickly apply formatting to a range of selected cells. However I would like to be able format individual columns of the selected range. For example in each of the columns I would like to be able to: change the font name, change the font size, wrap text in the cell, centre the alignment, etc. I realise that within the macro the format of a set number of columns will hard coded, which means if the range of selected cells is wider that what has been hard coded they will not have their formatting changed. How can the following macro be changed to enable the formatting of each adjacent column in the selected range to be changed. Code:
Sub GetUserRange() 'https://www.reddit.com/r/excel/comments/1hp6fw/vba_first_row_formatting_in_a_selection/ Dim UserRange As Range Dim UsedCell As Range Dim X As Long Dim Y As Long Dim XX As Long Dim YY As Long On Error Resume Next Set UserRange = Application.InputBox(prompt:="Select a range", Title:="Select a range", Default:=ActiveCell.Address, Type:=8) On Error GoTo 0 If UserRange Is Nothing Then MsgBox "Action canceled by user" Else X = UserRange.Rows.Row Y = UserRange.Columns.Column XX = UserRange.Rows.Count - 1 YY = UserRange.Columns.Count - 1 ' ***** USE THE FOLLOWING ***** USE THE FOLLOWING ***** 'Range(Cells(X, Y), Cells(X, Y + YY)).Style = "Calculation" ' do the header row work here using a 'style' ' ***** OR USE THE FOLLOWING ***** OR USE THE FOLLOWING ***** With Range(Cells(X, Y), Cells(X, Y + YY)).Font ' do the header row work here .Name = "Arial" .FontStyle = "Bold" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With ' ***** ***** ***** ***** ***** ***** ***** ***** ***** ***** For Each UsedCell In Range(Cells(X + 1, Y), Cells(X + XX, Y + YY)) ' do the cell formatting here UsedCell.Borders(xlEdgeTop).LineStyle = xlContinuous UsedCell.Borders(xlEdgeTop).Weight = xlThin UsedCell.Borders(xlEdgeLeft).LineStyle = xlContinuous UsedCell.Borders(xlEdgeLeft).Weight = xlThin UsedCell.Borders(xlEdgeBottom).LineStyle = xlContinuous UsedCell.Borders(xlEdgeBottom).Weight = xlThin UsedCell.Borders(xlEdgeRight).LineStyle = xlContinuous UsedCell.Borders(xlEdgeRight).Weight = xlThin UsedCell.Borders(xlDiagonalDown).LineStyle = xlNone UsedCell.Borders(xlDiagonalUp).LineStyle = xlNone UsedCell.Borders(xlInsideVertical).LineStyle = xlNone UsedCell.Borders(xlInsideHorizontal).LineStyle = xlNone UsedCell.Interior.Pattern = xlSolid UsedCell.Interior.PatternColorIndex = xlAutomatic UsedCell.Interior.ThemeColor = xlThemeColorLight2 UsedCell.Interior.TintAndShade = 0.799981688894314 UsedCell.Interior.PatternTintAndShade = 0 Next UsedCell End If UserRange.Select End Sub On another question… What is the best way to format a range of cells in various columns (A to K)? The following is part of what I am currently using, but I suspect it is clumsy and there is a much better way to do it, hence my question. I have a report that goes from column A to K and I would like to be able select the data range in column A (not including headers) and have the macro apply different formatting to different columns as requested above. The problem I have is that I would like to formatting applied to cells to the right of the selected data in column A. The following is what I use in another report, but it does not work very well when I have several groups of data each with their own headings and the macro formats everything below the row 2 (all my row headings get formatted by the macro and I have to manually redo them). I think it has something to do with OFFSET and RESIZE, but I have yet to find anything much when I search for examples. Code:
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 = xlGeneral 'OR use 'xlGeneral', 'xlLeft', 'xlRight', 'xlCenter .VerticalAlignment = xlBottom 'OR use xlTop, xlBottom, xlCenter .WrapText = False 'Wraps text with the cell - Change to True if you do not want text to wrap .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .ColumnWidth = 8.43 'Change column width here .Rows.AutoFit 'This allows rows to increase in height to fit cell contents - Comment out if not required 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" 'Change font type here .Bold = False .Size = 8 '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 = xlGeneral 'OR use 'xlGeneral', 'xlLeft', 'xlRight', 'xlCenter .VerticalAlignment = xlBottom 'OR use xlTop, xlBottom, xlCenter .WrapText = True 'Wraps text with the cell - Change to True if you do not want text to wrap .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .ColumnWidth = 8.43 'Change column width here .Rows.AutoFit 'This allows rows to increase in height to fit cell contents - Comment out if not required End With End With End Sub Regards, Dave T |
#2
|
|||
|
|||
Hello All,
I decided to simplify what I was asking for and posted my question in another forum http://www.vbaexpress.com/forum/show...n-of-selection Sam T was extremely helpful in pointing me in the right direction. His solution with my minor changes will suit my needs. Regards, Dave T |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Copying text range of cells to different cells adds an extra line | jpb103 | Word VBA | 2 | 07-23-2014 12:22 PM |
How-TO format cells (FILL) by comparing cells | zanat0s | Excel | 1 | 07-03-2012 04:27 AM |
Set range for merged Word table cells? | tinfanide | Word VBA | 1 | 02-06-2012 05:57 AM |
Count range cells eliminating merge cells | danbenedek | Excel | 0 | 06-15-2010 12:40 AM |
Cut and paste a range of cells and preserve formatting | StarWeaver | Excel | 1 | 03-02-2010 01:41 PM |