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
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.AutoFit
with
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?
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?
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.
.Name = "MuktaMahee Bold"
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
No problem! Glad your issue got resolved.
Please give this a try...
Open in new window