Auto Size Wrapped/Merged Cells

[stefan h via OfficeKB.com]

Hello,
The following code works - with a couple flaws for which I'd like assistance
please.

The goal is to have the ranges CommentRange1 (C22:H22) and CommentRange2 (G43:
H43) auto adjust in height when the user inputs data in these ranges. This
works. However, at times, when the file is saved and later recalled, the said
ranges are hidden away.

Another flaw is that when selecting a range that includes the areas, say B22:
H22, it either hides the rows and/or errors in "The selection contains
multiple data values. Merging into one cell will keep the upper-mist left
data only." Btw, why does the option in the error says "OK" and "Cancel" when
both result in the same!? and Cancel does not cancel?

Help changing the existing code to prevent these errors and/or new code to
achieve the same would be greatly appreciated.

Stefan


Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
' Auto adjust cell size for comment fields
Dim RowHt As Single, MergeWidth As Single
Dim C As Range, AutoFitRng As Range
Dim CWidth As Single, NewRowHt As Single
Static OldRngAdd As String
Dim OldRng As Range
On Error Resume Next
If bDisableEvents Then Exit Sub
If OldRngAdd = "" Then
Set OldRng = Union(Range("CommentRange1").MergeArea, Range
("CommentRange2").MergeArea)
OldRngAdd = OldRng.Address
Else
Set OldRng = Range(OldRngAdd)
End If
Set AutoFitRng = Union(Range("CommentRange1"), Range("CommentRange2"))
If Not Intersect(OldRng, AutoFitRng) Is Nothing Then
Application.ScreenUpdating = False
With OldRng
RowHt = .RowHeight
CWidth = .Cells(1).ColumnWidth
For Each C In OldRng
MergeWidth = C.ColumnWidth + MergeWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
.Locked = False
End With
Application.ScreenUpdating = True
End If
OldRngAdd = Target.Address
End Sub

<fyi - this is a repost>

 

[stefan h via OfficeKB.com]

Alright. Found my own work around. For anyone who might be in the same
position, looking for an autofit on merged and wrapped cells.

My ranges, CommentRange1 (C22:H22) and CommentRange2 (G43:H43), are for the
user to input text.

I added the column sizes/width for C:H.
Say, every column is set to 10.
6 columns (C, D, E, F, G and H) x 10 = 60.
Then I created a cell (column AA) in the same rows (22 and also in 43) with
the size set to 60.
Then I formatted these cells (AA22 and AA43) to wrap text.
Then I name the ranges AA22 as "Fit1" and AA43 as "Fit2".
And added code to autofit as follows:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Range("Fit1").EntireRow.autofit
Range("Fit2").EntireRow.autofit
End Sub
Hope this helps.