try:
Code:
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!