Autofit Rows with a Maximum Row Height

Follow up post

In March I wrote a post on using a macro to apply column Autofit on a sheet but with a maximum column width. This is a follow up post as someone requested the same functionality for row height.

You can see the previous post here.

The code below works on the active sheet. I have replaced the variable c with r (for rows) and changed all the column commands and variables to rows.

The only problem with this technique is that the main reason a row height changes is to display a cell with a larger font. If you reduce the row height then the contents of those larger font rows may not display properly.

Sub AutoFitAllRowsActive()
 
Dim r
Dim ws As Worksheet
Dim lnumRows As Long
Dim lMaxHeight As Long
 
Set ws = ActiveSheet
 
lnumRows = ws.UsedRange.Rows.Count
lMaxHeight = 40
 
ws.Rows.AutoFit
 
For r = 1 To lnumRows
  If ws.UsedRange.Rows(r).RowHeight > lMaxHeight Then
    ws.UsedRange.Rows(r).RowHeight = lMaxHeight
  End If
Next r
 
Set ws = Nothing
 
End Sub

 

Please note: I reserve the right to delete comments that are offensive or off-topic.

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

2 thoughts on “Autofit Rows with a Maximum Row Height

  1. Hi there,

    How could I augment this formula to only adjust certain row heights (ex: Row 3:66). I’d like to be able to autofit row heights but also have a maximum limit of 125. We have one column that has a ton of text and extends the rows significantly when autofitting. Want to be able to keep the text in there but basically ignore that column when autofitting the rows.

    Best,
    Conno

    • Hi Conno

      Try this – save the file as another version just in case.

      Sub AutoFitAllRowsActiveSpecific()

      Dim r
      Dim ws As Worksheet
      Dim lMaxHeight As Long

      Set ws = ActiveSheet

      lMaxHeight = 125

      ws.Rows(“3:66”).AutoFit

      For r = 3 To 66
      If ws.Rows(r).RowHeight > lMaxHeight Then
      ws.Rows(r).RowHeight = lMaxHeight
      End If
      Next r

      Set ws = Nothing
      End Sub