Auto Row Height in Merged Cells with pre exisiting text

[gwinder]

I have applied a macro to automatically adjust the row height when entering
text into merged cells. It works fine when the whole row has no text in it.
However, when I enter text into a blank cell that is in a row that has text
in it, the row height adjusts to the amount of text I enter in the blank
cell, not the height based on how much text is in the cell next to it.

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

[gwinder]

Cells A1:C1 are merged with wrap text. I have entered six lines of text and
row height automatically adjusted because I have the macro running to do this.

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]

Maybe you can change your macro to only increase the rowheight. (If the
rowheight after your routine would be smaller than the existing rowheight, then
don't change it.)

--

Dave Peterson

[gwinder]

Dave....I copied the macro from Jim Rech I think so I don't really know how
to make the change you're suggesting. If I emialed the worksheet to you
could you take a look at it please?

Thanks,

Gary

gwi...@yamaha.com

[Dave Peterson]

Nope. I don't open unsolicited workbooks.

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

[gwinder]

Thanks Dave...here is the code I'm using.

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

[Dave Peterson]

Maybe you can modify this (modified from a previous tested version--but not
tested this time):

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

[gwinder]

Dave...I copied the modified version to my worksheet and the row height is
not adjusting at all. Do I need to reference the cell range and if so where
does that go in the code. The cell range is A50:AA142

Thanks,

Gary

[Dave Peterson]

Maybe you should change this portion:

if intersect(target,me.range("A1:AA175") is nothing then

Does the event fire at all?

--

Dave Peterson

[gwinder]

No...it's not working at all now. This is what I have in the code:

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:

[Dave Peterson]

In Jim's code, he has a line like this:

.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

[gwinder]

I was looking through my records and it is Greg Wilson's code I am using
which he may have gort from Jim.. Anyway, I tried putting the additional line
in several places but I still can't get it to work. It will if I go back to
the largest cell and click...just won't do it automatically?

[Dave Peterson]

Keep the code that I took from Jim Rech.

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

[gwinder]

Dave...I'm not sure I understand...and forgive my stupidity...this is all
very new to me. Where should the Jim Rech code be? I right clicked on the
sheet tab/View Code and then pasted the code. In the left drop down menu it
has (General) and iin the right drop down it has AutoFitMergedCellRowHeight.
What is the worksheet_change event code? And where would this code go?

[Dave Peterson]

Put Jim's code in a General module.

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

[gwinder]

Dave...It's not working so I must be doing something wrong. My company has a
subscription to WebEx. Would you be interested in seeing the worksheet
online. I can conference you into my computer over the internet so you see
what I have without me sending you the file?

[Dave Peterson]

No thanks to the webex stuff.

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