Excel 2003 - autofitting rows based only on selected column

[chrisjj]

I want one operation to set the height of all rows to the minimum height needed by any cell in Column O.

Any ideas?

I've tried everything from:

Worksheets("Sheet1").Columns("O").Rows.AutoFit

to ChatGPT's:

Sub AutofitRowsToColumnO()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim minHeight As Double
    
    Set ws = ActiveSheet
    ' Work on used range in Column O
    Set rng = ws.Range("O1:O" & ws.Cells(ws.Rows.Count, "O").End(xlUp).Row)
    
    Application.ScreenUpdating = False
    
    For Each cell In rng
        ' Autofit just this cell
        cell.EntireRow.AutoFit
        
        ' Now capture its required height
        minHeight = cell.RowHeight
        
        ' Reset row height to this minimum
        cell.EntireRow.RowHeight = minHeight
    Next cell
    
    Application.ScreenUpdating = True
End Sub

The best I ever get (even with all cells unmerged) seems to count in other columns, pranging the result. A workaround is to set all other columns to no Wrap Text and set my Col O to Yes Wrap Text.

[p45cal]

try:

Sub AutofitRowsToColumnO()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim minHeight As Double
    
Set ws = ActiveSheet
' Work on used range in Column O
Set rng = ws.Range("O1:O" & ws.Cells(ws.Rows.Count, "O").End(xlUp).Row)
    
Application.ScreenUpdating = False
minHeight = 1E+99
For Each cell In rng
  cell.Rows.AutoFit
  minHeight = Application.Min(minHeight, cell.RowHeight)
Next cell
rng.EntireRow.RowHeight = minHeight
Application.ScreenUpdating = True
End Sub

This will get you closer but won't work properly because Excel's cell.Rows.AutoFit does not work on a single cell like cell.Columns.AutoFit does!

[chrisjj]

Thank you.