Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 05-30-2016, 06:59 PM
Dave T Dave T is offline Format a range of cells Windows 7 64bit Format a range of cells Office 2007
Advanced Beginner
Format a range of cells
 
Join Date: Nov 2014
Location: Australia
Posts: 66
Dave T is on a distinguished road
Default 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
Any help would be greatly appreciated.
Regards,
Dave T
Reply With Quote
  #2  
Old 06-01-2016, 08:58 PM
Dave T Dave T is offline Format a range of cells Windows 7 64bit Format a range of cells Office 2007
Advanced Beginner
Format a range of cells
 
Join Date: Nov 2014
Location: Australia
Posts: 66
Dave T is on a distinguished road
Default

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
Reply With Quote
Reply

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
Format a range of cells How-TO format cells (FILL) by comparing cells zanat0s Excel 1 07-03-2012 04:27 AM
Format a range of cells 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
Format a range of cells Cut and paste a range of cells and preserve formatting StarWeaver Excel 1 03-02-2010 01:41 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:30 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft