Compare textwidth with cellwidth in Excel?
Hello Jim,
Excellent macro. I'm wondering if there's a way of doing this in multiple rows at once. Is this possible? JC |
Compare textwidth with cellwidth in Excel?
I found this code and made improvement so it can support multiple cells selection. It's little bit tricky to deal with vertical oriented text but this code support it as well (small correction is required to switch off text wrapping in case of vertical text orientation, but I omit to do it - no more time). Code checks user selection and does not support entire rows our columns selection although it can work with it (just remove checking code). Thanks guys for starting code and my code version is the following:
Sub AutoFitMergedCellRowHeight() Dim cell As Object Dim CurrentRowHeight As Single, MergedCellRgWidth As Single Dim CurrCell As Range Dim PrevMerge As Range Dim ActiveCellWidth As Single, PossNewRowHeight As Single Dim FirstCell As Boolean If Selection.Address = "$1:$1048576" Then MsgBox ("This macro procedure for RowAutofit does not support entire rows or columns selection") Exit Sub End If If Selection.Row 0 And Selection.count = Columns.count Then MsgBox ("This macro procedure for RowAutofit does not support entire rows or columns selection") Exit Sub End If If Selection.Column 0 And Selection.count = Rows.count Then MsgBox ("This macro procedure for RowAutofit does not support entire rows or columns selection") Exit Sub End If FirstCell = True Set PrevMerge = Selection.Cells(1).MergeArea For Each cell In Selection If cell.MergeArea.Address < PrevMerge.Address Or FirstCell Then With cell.MergeArea If .Rows.count = 1 And .WrapText = True Then Application.ScreenUpdating = False CurrentRowHeight = .RowHeight ActiveCellWidth = cell.ColumnWidth For Each CurrCell In cell.MergeArea CurrCell.Orientation = cell.MergeArea.Cells(1).Orientation MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth Next .MergeCells = False .Cells(1).ColumnWidth = MergedCellRgWidth .EntireRow.AutoFit PossNewRowHeight = .RowHeight .Cells(1).ColumnWidth = ActiveCellWidth .MergeCells = True .RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _ CurrentRowHeight, PossNewRowHeight) CurrentRowHeight = 0 ActiveCellWidth = 0 MergedCellRgWidth = 0 PossNewRowHeight = 0 End If End With End If Set PrevMerge = cell.MergeArea Application.ScreenUpdating = True FirstCell = False Next cell End Sub |
All times are GMT +1. The time now is 11:51 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com