VBA Code to Auto Fit Row Height

Justinian

Well-known Member
Joined
Aug 9, 2009
Messages
1,551
Office Version
  1. 365
Platform
  1. Windows
How do I modify this code to have Excel grab all used rows and format all row heights to 15.00?

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Format_Make_Ready_Board()[/FONT]


[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] 'Formats columns and rows
Cells.Select
Selection.Font.Size = 8
Rows("2:2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$2"
.PrintTitleColumns = ""
End With

'Deletes unwanted columns before sorting
Range("B:B,D:D,H:K,N:N").Select
Range("N1").Activate
ActiveWindow.SmallScroll ToRight:=12
Range("B:B,D:D,H:K,N:N,AA:AA,AD:AE").Select
Range("AD1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = "$A$1:$U$159"
ActiveWindow.View = xlNormalView

'Sort entire data range by last name based on column G (complete by date)
With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SortFields.Clear
.SortFields.Add Key:=Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A2:U" & Cells(Rows.Count, "E").End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub
[/FONT]
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Maybe this

Code:
Sub Format_Make_Ready_Board()
'Formats columns and rows
With ActiveSheet.UsedRange
    .Font.Size = 8
    .RowHeight = 15
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
With ActiveSheet.PageSetup
    .PrintTitleRows = "$2:$2"
    .PrintTitleColumns = ""
End With

'Deletes unwanted columns before sorting
Range("B:B,D:D,H:K,N:N,AA:AA,AD:AE").Select
Range("AD1").Activate
Selection.Delete Shift:=xlToLeft
Range("A1").Select
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = "$A$1:$U$159"
ActiveWindow.View = xlNormalView

'Sort entire data range by last name based on column G (complete by date)
With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SortFields.Clear
.SortFields.Add Key:=Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A2:U" & Cells(Rows.Count, "E").End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub
 
Upvote 0
Sorry, I screwed up; I meant every row except the 1 and 2.
 
Upvote 0
This then...

Code:
Sub Format_Make_Ready_Board()
'Formats columns and rows
Dim lr As Long, lc As Long
lc = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
lr = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
With Range(Cells(3, 1), Cells(lr, lc))
    .Font.Size = 8
    .RowHeight = 15
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
With ActiveSheet.PageSetup
    .PrintTitleRows = "$2:$2"
    .PrintTitleColumns = ""
End With

'Deletes unwanted columns before sorting
Range("B:B,D:D,H:K,N:N,AA:AA,AD:AE").EntireColumn.Delete
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = "$A$1:$U$159"
ActiveWindow.View = xlNormalView

'Sort entire data range by last name based on column G (complete by date)
With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SortFields.Clear
.SortFields.Add Key:=Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A2:U" & Cells(Rows.Count, "E").End(xlUp).Row)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub
 
Last edited:
Upvote 0
That works except it is changing rows 1 and 2 (font size and row height). I want am trying to leave rows 1 and 2 alone and just format row 3 and below. Row 1 height should be 30.60 and row 2 height should be 20.40 with Calibri 8 centered horizontally and vertically. I am not sure what is happening.
 
Upvote 0
Did you reset rows 1 and 2 after the 1st code was run ?
The revised code I provided works fine for me !
I can put the required code in to set rows 1 and 2 but shouldn't be required once they are set !
 
Upvote 0
Sorry, it was a long day yesterday - your code works!

May I ask one more question?

In the same workbook, I have code to open "Book1" from my desktop, copy the data from "Book1," and paste into this macro-enabled workbook. The problem is my code to open "Book1" does not work because the code gets hung up on this line:

Windows("Book1.xlsx").Activate

When I record a macro and open "Book1, " then stop recording, this is exactly the code the macro records but when I insert said code into my macro, "Book1" will not open and I have to manually open it before I can run my copy / paste macro.

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Sub Insert_Make_Ready_Board()[/FONT]


[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] 'This copies all data from the exported Make Ready Board and pastes said data into Ana's Make Ready Macro workbook
Cells.Select
Selection.Delete Shift:=xlUp
Range("A12").Select
Rows("1:1").RowHeight = 30.75
Windows("Book1.xlsx").Activate
Sheets("Make Ready Board").Select
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Ana's Make Ready Macro.xlsm").Activate
Rows("2:2").Select
ActiveSheet.Paste
Range("A2").Select

End Sub[/FONT]
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

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