Autofit columns with a limit

A macro to the rescue

The column Autofit on the whole sheet is a great Excel feature. But if you have a few columns that have lots of text it can make using it problematic as you need to manually adjust those wide columns. Here’s a macro to make it easier.

The code below will apply column Autofit to the active sheet with a maximum column width of 35.

 

Sub AutoFitAllColumnsActive()
 
Dim c
Dim ws As Worksheet
Dim lnumCols As Long
Dim lMaxWidth As Long
 
Set ws = ActiveSheet
 
lnumCols = ws.UsedRange.Columns.Count
lMaxWidth = 35
 
ws.Columns.AutoFit
 
For c = 1 To lnumCols
  If ws.UsedRange.Columns(c).ColumnWidth > lMaxWidth Then
    ws.UsedRange.Columns(c).ColumnWidth = lMaxWidth
  End If
Next c
 
Set ws = Nothing
 
End Sub

 

If you need to do this flexibly via VBA code then below is a function that allows you to specify the sheet and the width you want to use.

 

Function AutoFitAllColumns(ws As Worksheet, lMaxWidth As Long)
Dim c
Dim lnumCols As Long
lnumCols = ws.UsedRange.Columns.Count
ws.Columns.AutoFit
 
For c = 1 To lnumCols
  If ws.UsedRange.Columns(c).ColumnWidth > lMaxWidth Then
    ws.UsedRange.Columns(c).ColumnWidth = lMaxWidth
  End If
Next c
 
End Function

 

To use the above function you would have code like

 

Sub Test()
 
AutoFitAllColumns Sheet1,40
 
End Sub

 

Related Posts

Posted on
Categories: Excel Blog, Macros

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 columns with a limit”

    • Hi Adriano

      The macro below should do it

      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

      Reply