View Single Post
 
Old 09-21-2025, 04:50 AM
p45cal's Avatar
p45cal p45cal is offline Windows 10 Office 2021
Expert
 
Join Date: Apr 2014
Posts: 956
p45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond repute
Default

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!
Reply With Quote