vba font size/row&column width

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
444
Office Version
  1. 2019
greeting to all of you

i'm a beginner of vba, i've recorded some macro below to run my workbook, but i got some error with the outcome, can anyone with your kind guidance help me out?
my expectation are:
~ row 1 height was 100 instead of frist 3 rows
~ column A:H width was 80 instead of column D only 80 (*even column G:H width should be 15)
~ cell B1:F1 & cell B5:F5 should merged

*font size should be correct now
what did i wrong?

appreciate for the poor english

VBA Code:
Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveWorkbook.Sheets.Select

    Cells.Select
    Cells.EntireRow.AutoFit

    Rows("9:38").Select
    Selection.RowHeight = 30
    Rows("1:1").Select
    Selection.RowHeight = 100
    Columns("G:H").Select
    Selection.ColumnWidth = 15

    Range("B1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 80
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    Range("B1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge

    Range("B5:F5").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge

    Columns("B:B").EntireColumn.AutoFit
    Columns("D:D").Select
    Range("D2").Activate
    Selection.ColumnWidth = 80

    Range("A1").Select
End Sub
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
what width were you expectin column a,b,c,e,f to be?
 
Upvote 0
what width were you expectin column a,b,c,e,f to be?
gordsky
thank you for your reply

all of the worksheet in this workbook original width are:
A: 12 / B: 22 / C: 14 / D:50 / E: 9 / F:14 / G&H&I: 19 / J: 7

all i want is, run the macro, all sheet in the workbook will goes:
B: autofit or same as G&H: 15
D: 80
row 1: 100
row 9-38: 30
and cell B1:F1 & B5:F5 merged

ps: i can get this outcome in first sheet, but not all sheets

thank you very much for your help
 
Upvote 0
Apologies but I found it a little hard to follow your request. I tried to look at your first code and your later posts and think this will do what you want.
It will change all worksheets in your workbook with one run of the code as I think that is what you were asking for. You dont need to select the cells in the way you were doing so I have shortened the code slightly as you also appeared to be repeating the horizontalalignement section on 3 occasions when you could do it in one. Let me know if this isnt what you need

VBA Code:
Sub SheetAdjust()
Dim ws As Worksheet
Dim wb As Workbook

Set wb = ThisWorkbook

For Each ws In ThisWorkbook.Worksheets

    With ws
      .Rows(1).RowHeight = 100
      .Rows("9:38").RowHeight = 30
      .Range("B1:F1,B5:F5").Merge
      .Columns("B").EntireColumn.AutoFit
      .Columns(1).ColumnWidth = 12
      .Columns("G:H").ColumnWidth = 15
      .Columns("D").ColumnWidth = 80
    End With
   
    With ws.Range("B1").Font
      .name = "Calibri"
      .Size = 80
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
   
    With ws.Range("B1:F1,B5:F5")
     .Merge
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlTop
     .WrapText = False
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
    End With

Next ws
End Sub
.
 
Upvote 0
Apologies but I found it a little hard to follow your request. I tried to look at your first code and your later posts and think this will do what you want.
It will change all worksheets in your workbook with one run of the code as I think that is what you were asking for. You dont need to select the cells in the way you were doing so I have shortened the code slightly as you also appeared to be repeating the horizontalalignement section on 3 occasions when you could do it in one. Let me know if this isnt what you need

VBA Code:
Sub SheetAdjust()
Dim ws As Worksheet
Dim wb As Workbook

Set wb = ThisWorkbook

For Each ws In ThisWorkbook.Worksheets

    With ws
      .Rows(1).RowHeight = 100
      .Rows("9:38").RowHeight = 30
      .Range("B1:F1,B5:F5").Merge
      .Columns("B").EntireColumn.AutoFit
      .Columns(1).ColumnWidth = 12
      .Columns("G:H").ColumnWidth = 15
      .Columns("D").ColumnWidth = 80
    End With
  
    With ws.Range("B1").Font
      .name = "Calibri"
      .Size = 80
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
  
    With ws.Range("B1:F1,B5:F5")
     .Merge
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlTop
     .WrapText = False
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
    End With

Next ws
End Sub
.
gordsky
thank you for your reply

JESUS, you just did what i exactly want!!!

one more question would like to ask
if i want to adjust font size 14 in between of D9:D38 and wrap text
how about this?
VBA Code:
    With ws.Range("D9:D38").Font
      .Name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
    
    With ws.Range("D10:D14").Select
    With Selection
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

thank you very much
 
Upvote 0
gordsky
thank you for your reply

JESUS, you just did what i exactly want!!!

one more question would like to ask
if i want to adjust font size 14 in between of D9:D38 and wrap text
how about this?
VBA Code:
    With ws.Range("D9:D38").Font
      .Name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
   
    With ws.Range("D10:D14").Select
    With Selection
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

thank you very much
yes the D9:D38 will work
The line below for D10:d14 if you are using that as well then there is no need to select
If this reslves your query then please show as solved by clicking the tick next to the answer
 
Upvote 0
yes the D9:D38 will work
The line below for D10:d14 if you are using that as well then there is no need to select
If this reslves your query then please show as solved by clicking the tick next to the answer
i finally used this and it return next without for?

VBA Code:
    With ws.Range("D9:D38").Font
      .Name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("D9:D38").Select
    With Selection
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
 
Upvote 0
this is what i'm using, a little bit font size, row height, column width adjusted.

thank you very much again for the big help

VBA Code:
Sub SheetAdjust()
Dim ws As Worksheet
Dim wb As Workbook

Set wb = ThisWorkbook

For Each ws In ThisWorkbook.Worksheets

    With ws
      .Rows(1).RowHeight = 100
      .Rows("2:5").RowHeight = 20
      .Rows("10:39").RowHeight = 40
      .Range("B1:F1,B5:F5").Merge
      .Columns("B").EntireColumn.AutoFit
      .Columns(1).ColumnWidth = 12
      .Columns("G:H").ColumnWidth = 15
      .Columns("D").ColumnWidth = 80
    End With

    With ws.Range("B1").Font
      .Name = "Calibri"
      .Size = 75
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

        With ws.Range("B2:B5").Font
      .Name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("D10:D39").Font
      .Name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("D10:D39").Select
    With Selection
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("A1").Select

    With ws.Range("B1:F1,B2:F2,B3:F3,B4:F4,B5:F5")
     .Merge
     .HorizontalAlignment = xlLeft
     .VerticalAlignment = xlTop
     .WrapText = False
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
    End With

    ActiveWorkbook.Sheets.Select
    Range("A1").Select
    Sheets(1).Select

Next ws
End Sub
 
Upvote 0
you have a lot of unneeded code in there and its quite different to the code i gave you.
try this. If happy please mark as resolved by clicking the tick next to the post with the solution
VBA Code:
Sub SheetAdjust()
Dim ws As Worksheet
Dim wb As Workbook

Set wb = ThisWorkbook

For Each ws In ThisWorkbook.Worksheets

    With ws
      .Rows(1).RowHeight = 100
      .Rows("2:5").RowHeight = 20
      .Rows("10:39").RowHeight = 40
      .Range("B1:F1,B5:F5").Merge
      .Columns("B").EntireColumn.AutoFit
      .Columns(1).ColumnWidth = 12
      .Columns("G:H").ColumnWidth = 15
      .Columns("D").ColumnWidth = 80
    End With

    With ws.Range("B1").Font
      .name = "Calibri"
      .Size = 75
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("B2:B5").Font
      .name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("D10:D39")
    With .Font
      .name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    
    With ws.Range("B1:F1,B2:F2,B3:F3,B4:F4,B5:F5")
     .Merge
     .HorizontalAlignment = xlLeft
     .VerticalAlignment = xlTop
     .WrapText = False
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
    End With

    ws.Activate
    ws.Range("A1").Select
   
Next ws
 Sheets(1).Select
End Sub
 
Upvote 0
Solution
you have a lot of unneeded code in there and its quite different to the code i gave you.
try this. If happy please mark as resolved by clicking the tick next to the post with the solution
VBA Code:
Sub SheetAdjust()
Dim ws As Worksheet
Dim wb As Workbook

Set wb = ThisWorkbook

For Each ws In ThisWorkbook.Worksheets

    With ws
      .Rows(1).RowHeight = 100
      .Rows("2:5").RowHeight = 20
      .Rows("10:39").RowHeight = 40
      .Range("B1:F1,B5:F5").Merge
      .Columns("B").EntireColumn.AutoFit
      .Columns(1).ColumnWidth = 12
      .Columns("G:H").ColumnWidth = 15
      .Columns("D").ColumnWidth = 80
    End With

    With ws.Range("B1").Font
      .name = "Calibri"
      .Size = 75
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("B2:B5").Font
      .name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("D10:D39")
    With .Font
      .name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
   
    With ws.Range("B1:F1,B2:F2,B3:F3,B4:F4,B5:F5")
     .Merge
     .HorizontalAlignment = xlLeft
     .VerticalAlignment = xlTop
     .WrapText = False
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
    End With

    ws.Activate
    ws.Range("A1").Select
  
Next ws
 Sheets(1).Select
End Sub

gordsky
thank you very much for all of this help

i'm still learning coding, even i dont understand too much of "dim ws as... dim wb as...... or next......" i can just record so i may have lot of unneeded as what you said
i'm sorry

now i can go to my next difficulties - color tab if found same result, and continue my workbook

thank you again
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,700
Members
448,293
Latest member
jin kazuya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top