Wrap in merged cells

N

Nick Smith

Folks, Am using the following macro to wrap text in merged cells - unmerges,
wraps, set's height and remerges in essence. For some reason is has stopped
working - any ideas as I am completely stumped!!!! No error messages either.

Thanks / Nick

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
ActiveSheet.Unprotect Password:="ericsson"
Selection.RowHeight = 12.75
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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)
End If
Selection.Locked = False
Selection.FormulaHidden = False
Call ProtectStatusReportWithPassword
End With
End If
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top