- VBA
- Microsoft Excel
- PC
- Automatic save
- Microsoft Office
VBA Script to change font (size&style) for specific text in document
All my Catalog Excel files have 3 different font styles.
1. Title of Products - this is Blue text font size 11.5
2. under that (#1 Title of Products) is Bold Text and underlined font size 9
3. then is a list of part#'s font size 9 regular text
Currently the font is Helvetica for all of them but I need to change font. I can select the whole doc and change the font but I also need to update the font sizes for each of the above 1. 2, and 3 types of text in my doc. I am using Mac Excel and it does have the same Find Tool as on a PC so I need a VBA script to do this.
I Recorded a Macro but this requires me to manually select each type of row. I need the VBA script to be able to find each of the 1, 2, and 3 above and change font style.
Here is a sample of what the Macro recorded when changing the #1 Title of Products manually.
Sub fontchange()
'
' fontchange Macro
'
'
Rows("8:8").Select
With Selection.Font
.Name = "MuktaMahee Bold"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "MuktaMahee Bold"
.Size = 11.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
![Screen-Shot-2020-02-06-at-9.15.12-PM.jpg]()
Tomlinson.xls
1. Title of Products - this is Blue text font size 11.5
2. under that (#1 Title of Products) is Bold Text and underlined font size 9
3. then is a list of part#'s font size 9 regular text
Currently the font is Helvetica for all of them but I need to change font. I can select the whole doc and change the font but I also need to update the font sizes for each of the above 1. 2, and 3 types of text in my doc. I am using Mac Excel and it does have the same Find Tool as on a PC so I need a VBA script to do this.
I Recorded a Macro but this requires me to manually select each type of row. I need the VBA script to be able to find each of the 1, 2, and 3 above and change font style.
Here is a sample of what the Macro recorded when changing the #1 Title of Products manually.
Sub fontchange()
'
' fontchange Macro
'
'
Rows("8:8").Select
With Selection.Font
.Name = "MuktaMahee Bold"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "MuktaMahee Bold"
.Size = 11.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
Tomlinson.xls
Please give this a try...
Sub ChangeFontNameAndSize()
Dim lr As Long
Dim Rng As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
With Columns("A:E").Font
.Name = "MuktaMahee Bold"
.Size = 9
End With
For Each Rng In Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 3).Areas
Rng.Cells(1).Font.Size = 11.5
Next Rng
For Each Rng In Range("C1:C" & lr).SpecialCells(xlCellTypeConstants, 3).Areas
With Rng.Cells(1).Resize(1, 3).Font
.Bold = True
.Underline = True
End With
Next Rng
ActiveSheet.UsedRange.Columns.AutoFit
End Sub
If the sample file has a .doc file extension, rename it to Tomlinson.xls before trying to open it in Excel
Sub fontchange()
' fontchange Macro
'1. Title of Products - this is Blue text font size 11.5
'2. under that (#1 Title of Products) is Bold Text and underlined font size 9
'3. then is a list of part#'s font size 9 regular text
Dim rg As Range, rw As Range
Application.ScreenUpdating = False
Set rg = ActiveSheet.UsedRange
'Make all text "body" text
With rg.Font
.Name = "MuktaMahee Bold"
.Size = 9
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
For Each rw In rg.Columns(1).Cells
If rw.Value = "Part #" Then
'Part # row
With Intersect(rw.EntireRow, rg).Font
.Bold = True
.Underline = xlUnderlineStyleSingle
End With
'Title of Product row
With Intersect(rw.EntireRow, rg).Offset(-1, 0).Font
.Size = 11.5
.ColorIndex = 5
'.Color = 7811599
End With
End If
Next
End Sub
Few issues with this.
1. it changes the columns sizes. Seems random size for different docs i tested. Each Doc has different results.
2. Does Excels Bold Style the same thing as using the actual Font Style? the Specific Font Bold Style is "MuktaMahee Bold" . It looks like its the same to me.
Attaching a Doc that has the most errors and also changes the Row Heights.
VIQUA-Trojan-Ballasts---Parts-usa.xls
Screen-Shot-2020-02-06-at-9.59.57-PM.jpg
Screen-Shot-2020-02-06-at-10.00.33-P.jpg
1. it changes the columns sizes. Seems random size for different docs i tested. Each Doc has different results.
2. Does Excels Bold Style the same thing as using the actual Font Style? the Specific Font Bold Style is "MuktaMahee Bold" . It looks like its the same to me.
Attaching a Doc that has the most errors and also changes the Row Heights.
VIQUA-Trojan-Ballasts---Parts-usa.xls
Screen-Shot-2020-02-06-at-9.59.57-PM.jpg
Screen-Shot-2020-02-06-at-10.00.33-P.jpg
@byundt
The columns dont change so thats good! but strangely depending on what Excel Doc I run the script on the results vary. The Tomlinson Doc you sent me seemed to work the best but it made all the fonts Bold. So just changed your script from .Name = "MuktaMahee Bold" TO .Name = "MuktaMahee Regular"
This works great for this Particular Tomlinson doc... but other docs with same formatting have varied results same issue has Subodh's script. For example the attached screenshot shows the Blue Header text gets completely changed and the Row Heights get changed. Attaching that Excel file form the screenshot
Screen-Shot-2020-02-06-at-10.18.04-P.jpg
Valumax-Autotrol.xls
The columns dont change so thats good! but strangely depending on what Excel Doc I run the script on the results vary. The Tomlinson Doc you sent me seemed to work the best but it made all the fonts Bold. So just changed your script from .Name = "MuktaMahee Bold" TO .Name = "MuktaMahee Regular"
This works great for this Particular Tomlinson doc... but other docs with same formatting have varied results same issue has Subodh's script. For example the attached screenshot shows the Blue Header text gets completely changed and the Row Heights get changed. Attaching that Excel file form the screenshot
Screen-Shot-2020-02-06-at-10.18.04-P.jpg
Valumax-Autotrol.xls
Font name and row height seems to be correct to me.
As far as column width is concerned, you may replace the following line of code...
ActiveSheet.UsedRange.Columns.AutoFitwith
Columns("C:E").AutoFit
Sub ChangeFontNameAndSize()
Dim lr As Long
Dim Rng As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
With Columns("A:E").Font
.Name = "MuktaMahee Bold"
.Size = 9
End With
For Each Rng In Range("A1:A" & lr).SpecialCells(xlCellTypeConstants, 3).Areas
Rng.Cells(1).Font.Size = 11.5
Next Rng
For Each Rng In Range("C1:C" & lr).SpecialCells(xlCellTypeConstants, 3).Areas
With Rng.Cells(1).Resize(1, 3).Font
.Bold = True
.Underline = True
End With
Next Rng
Columns("C:E").AutoFit
End Sub
Please look at the green tab which contains the data after macro is run.
Let me know where the row height is changed?
Subodh, that seemed to fix the column resize issue. Thanks. still having the Row's resize in the Valumax Autotrol.xls file. Maybe this is a Mac VBA related issue?
Not sure about that.
But did you notice any difference in the row heights between two tabs where the first tab contains the original data?
The Tomlinson.xls has always been OK and the rows have not resized ever... its the other Excel Docs that are having issues. Can you download the Valumax Autotrol.xls I uploaded and see if that works wit your script.
Valumax-Autotrol.xls
Valumax-Autotrol.xls
In Tomlinson, Part # was in column A. In Valumax-Autotrol, it was in column. B. I changed the code to accommodate that, as well as use MuktaMahee Bold and MuktaMahee Regular fonts.
Sub fontchange()
' fontchange Macro
'1. Title of Products - this is Blue text font size 11.5
'2. under that (#1 Title of Products) is Bold Text and underlined font size 9
'3. then is a list of part#'s font size 9 regular text
Dim rg As Range, rw As Range
Application.ScreenUpdating = False
Set rg = ActiveSheet.UsedRange
'Make all text "body" text
With rg.Font
.Name = "MuktaMahee Regular"
.Bold = False
.Size = 9
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
For Each rw In rg.Rows
If Application.CountIf(rw, "Part #") > 0 Then
'Part # row
With rw.Font
.Name = "MuktaMahee Bold"
.Underline = xlUnderlineStyleSingle
End With
'Title of Product row
With rw.Offset(-1,0).Font
.Size = 11.5
.ColorIndex = 5
'.Color = 7811599
End With
End If
Next
End Sub
I found a mistake in my statement 23, and fixed it in the preceding Comment. Now it works with Valumax-Autotrol
Valumax-Autotrol.xls
Valumax-Autotrol.xls
Yes, in this file I noticed the change in the row height and the reason is when you increase the font size, the row height is automatically gets increased in order to accommodate the cell content.
In this file the other than blue headers the font size is set to 8 and when it is increased to size 9, the existing row height is not enough to accommodate the cell content and it is increased automatically.
Did you want the title to be MuktaMahee Regular or MuktaMahee Bold? My code made it Regular, but you could add the following statement to the With block handling the Title row if you wanted Bold:
.Name = "MuktaMahee Bold"
I was able to get byundt's script to work best. It was a bit easier to read and modify for my novice skills. I was able to add the .Name = "MuktaMahee Bold" to where i needed it.
Subodh - Thank you so much for your other script and continued help!!
byundt - I still get a row resize issue and I dont think I got new code from you after you mentioned a mistake in Statement 23 ? Here is the script I have from you:
Subodh - Thank you so much for your other script and continued help!!
byundt - I still get a row resize issue and I dont think I got new code from you after you mentioned a mistake in Statement 23 ? Here is the script I have from you:
Sub fontchange()
' fontchange Macro
'1. Title of Products - this is Blue text font size 11.5
'2. under that (#1 Title of Products) is Bold Text and underlined font size 9
'3. then is a list of part#'s font size 9 regular text
Dim rg As Range, rw As Range
Application.ScreenUpdating = False
Set rg = ActiveSheet.UsedRange
'Make all text "body" text
With rg.Font
.Name = "MuktaMahee Regular"
.Bold = False
.Size = 9
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
For Each rw In rg.Rows
If Application.CountIf(rw, "Part #") > 0 Then
'Part # row
With Intersect(rw.EntireRow, rg).Font
.Name = "MuktaMahee Bold"
.Underline = xlUnderlineStyleSingle
End With
'Title of Product row
With Intersect(rw.EntireRow, rg).Offset(-1, 0).Font
.Name = "MuktaMahee Bold"
.Size = 11
.ColorIndex = 5
'.Color = 7811599
End With
End If
Next
End Sub
Please change the code to:
Sub fontchange()
' fontchange Macro
'1. Title of Products - this is Blue text font size 11.5
'2. under that (#1 Title of Products) is Bold Text and underlined font size 9
'3. then is a list of part#'s font size 9 regular text
Dim rg As Range, rw As Range
Application.ScreenUpdating = False
Set rg = ActiveSheet.UsedRange
'Make all text "body" text
With rg.Font
.Name = "MuktaMahee Regular"
.Bold = False
.Size = 9
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
For Each rw In rg.Rows
If Application.CountIf(rw, "Part #") > 0 Then
'Part # row
With rw.Font
.Name = "MuktaMahee Bold"
.Underline = xlUnderlineStyleSingle
End With
'Title of Product row
With rw.Offset(-1, 0).Font
.Name = "MuktaMahee Bold"
.Size = 11
.ColorIndex = 5
'.Color = 7811599
End With
End If
Next
End Sub
-
![]()
received a Solution
Excel and Vba: loop for/next, how to set an automatic save -
![]()
wrote an Article
![]()
Rename a list of worksheets using VBA codes with conditions
-
![]()
created a Video
![]()
How to download number of Views, Endorsements, Points for Experts Exchange Articles and Videos--Demo
-
Explore Cloud Class® ![]()
Office 365 SharePoint for End Users
Premium Content
You need an Expert Office subscription to comment.Start Free Trial