Cells A1:C1 are merged and wrap text. I have entered six lines of text
which has automatically adjusted the row height to fit.
Cells D1:H1 are merged and wrap text. I have entered three lines of text
which now automatically adjusts the row height hiding three lines of text
from A1:C1. How do I get all six lines to to show?
Thanks,
Gary
Cells D1:G1 are merged with wrpa text. I enter three lines of text and row
height automatically adjusts for this cell only hiding three lines of text in
A1:C1. How do I get to see all six lines?
Thanks,
Gary
--
Dave Peterson
Thanks,
Gary
But I looked at the code that Jim posted:
http://groups.google.com/groups?threadm=e1%241uzL1BHA.1784%40tkmsftngp05
And saw this portion.
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
This says to not adjust the rowheight if the current row height is larger than
the possible new row height.
Maybe you made a change that broke this?????
--
Dave Peterson
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim r As Range, c As Range, cc As Range
Dim ma As Range
Set r = Range("A1:AA175")
If Not Intersect(Target, r) Is Nothing Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End Sub
Where would I insert the code that would leave the row height alone if it is
larger than the possible new row height.
Thanks
Gary
Behind the worksheet:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
if intersect(target,me.range("A1:AA175") is nothing then
exit sub
end if
If Target.MergeArea.Cells(1).Address <> Target.Address Then
Call AutoFitMergedCellRowHeight(myActiveCell:=Target)
End If
End Sub
In a general module is a modified version of Jim Rech's code:
Option Explicit
Sub AutoFitMergedCellRowHeight(myActiveCell As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim OrigMergeArea As Range
Dim CurrCell As Range
Dim myActiveCellWidth As Single, PossNewRowHeight As Single
If myActiveCell.MergeCells Then
Set OrigMergeArea = myActiveCell.MergeArea
With myActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
myActiveCellWidth = myActiveCell.ColumnWidth
For Each CurrCell In OrigMergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = myActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub
--
Dave Peterson
Thanks,
Gary
if intersect(target,me.range("A1:AA175") is nothing then
Does the event fire at all?
--
Dave Peterson
What am I missing?
Thanks,
Gary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim r As Range, c As Range, cc As Range
Dim ma As Range
Set r = Range("A1:AA175")
If Intersect(Target, Me.Range("A1:AA175")) Is Nothing Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End Sub
"Dave Peterson" wrote:
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
This line will increase the rowheight, but never decrease it.
You'll need something like that in your code.
--
Dave Peterson
But replace the worksheet_change event code with this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1:AA175")) Is Nothing Then
Exit Sub
End If
If Target.Cells(1).Value = "" Then Exit Sub
Call AutoFitMergedCellRowHeight(myActiveCell:=Target)
End Sub
--
Dave Peterson
Open your workbook
Open the VBE
hit ctrl-r to see the project explorer
select your project
Insert|Module
Paste Jim's code into that window.
--
Dave Peterson
If you want to send me the file, make it small sample. If you can't do that,
create a new workbook and set it up with enough data (with the code).
--
Dave Peterson