[lnkForumImage]
TotalShareware - Download Free Software
Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

microsoft.public.excel.programming

Re: Auto Row Height in Merged Cells with pre exisiting text

Dave Peterson

12/14/2006 4:07:00 PM

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.)



gwinder wrote:
>
> 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

--

Dave Peterson
13 Answers

Dave Peterson

12/14/2006 6:53:00 PM

0

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%40t...

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?????

gwinder wrote:
>
> 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
>
> gwinder@yamaha.com
>
> "Dave Peterson" wrote:
>
> > 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.)
> >
> >
> >
> > gwinder wrote:
> > >
> > > 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
> >
> > --
> >
> > Dave Peterson
> >

--

Dave Peterson

gwinder

12/15/2006 5:08:00 AM

0

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" wrote:

> 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%40t...
>
> 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?????
>
> gwinder wrote:
> >
> > 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
> >
> > gwinder@yamaha.com
> >
> > "Dave Peterson" wrote:
> >
> > > 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.)
> > >
> > >
> > >
> > > gwinder wrote:
> > > >
> > > > 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
> > >
> > > --
> > >
> > > Dave Peterson
> > >
>
> --
>
> Dave Peterson
>

Dave Peterson

12/15/2006 2:38:00 PM

0

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



gwinder wrote:
>
> 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" wrote:
>
> > 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%40t...
> >
> > 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?????
> >
> > gwinder wrote:
> > >
> > > 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
> > >
> > > gwinder@yamaha.com
> > >
> > > "Dave Peterson" wrote:
> > >
> > > > 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.)
> > > >
> > > >
> > > >
> > > > gwinder wrote:
> > > > >
> > > > > 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
> > > >
> > > > --
> > > >
> > > > Dave Peterson
> > > >
> >
> > --
> >
> > Dave Peterson
> >

--

Dave Peterson

gwinder

12/15/2006 3:26:00 PM

0

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" wrote:

> 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
>
>
>
> gwinder wrote:
> >
> > 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" wrote:
> >
> > > 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%40t...
> > >
> > > 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?????
> > >
> > > gwinder wrote:
> > > >
> > > > 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
> > > >
> > > > gwinder@yamaha.com
> > > >
> > > > "Dave Peterson" wrote:
> > > >
> > > > > 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.)
> > > > >
> > > > >
> > > > >
> > > > > gwinder wrote:
> > > > > >
> > > > > > 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
> > > > >
> > > > > --
> > > > >
> > > > > Dave Peterson
> > > > >
> > >
> > > --
> > >
> > > Dave Peterson
> > >
>
> --
>
> Dave Peterson
>

Dave Peterson

12/15/2006 4:09:00 PM

0

Maybe you should change this portion:

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

Does the event fire at all?

gwinder wrote:
>
> 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" wrote:
>
> > 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
> >
> >
> >
> > gwinder wrote:
> > >
> > > 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" wrote:
> > >
> > > > 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%40t...
> > > >
> > > > 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?????
> > > >
> > > > gwinder wrote:
> > > > >
> > > > > 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
> > > > >
> > > > > gwinder@yamaha.com
> > > > >
> > > > > "Dave Peterson" wrote:
> > > > >
> > > > > > 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.)
> > > > > >
> > > > > >
> > > > > >
> > > > > > gwinder wrote:
> > > > > > >
> > > > > > > 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
> > > > > >
> > > > > > --
> > > > > >
> > > > > > Dave Peterson
> > > > > >
> > > >
> > > > --
> > > >
> > > > Dave Peterson
> > > >
> >
> > --
> >
> > Dave Peterson
> >

--

Dave Peterson

gwinder

12/15/2006 11:59:00 PM

0

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:

> Maybe you should change this portion:
>
> if intersect(target,me.range("A1:AA175") is nothing then
>
> Does the event fire at all?
>
> gwinder wrote:
> >
> > 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" wrote:
> >
> > > 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
> > >
> > >
> > >
> > > gwinder wrote:
> > > >
> > > > 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" wrote:
> > > >
> > > > > 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%40t...
> > > > >
> > > > > 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?????
> > > > >
> > > > > gwinder wrote:
> > > > > >
> > > > > > 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
> > > > > >
> > > > > > gwinder@yamaha.com
> > > > > >
> > > > > > "Dave Peterson" wrote:
> > > > > >
> > > > > > > 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.)
> > > > > > >
> > > > > > >
> > > > > > >
> > > > > > > gwinder wrote:
> > > > > > > >
> > > > > > > > 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
> > > > > > >
> > > > > > > --
> > > > > > >
> > > > > > > Dave Peterson
> > > > > > >
> > > > >
> > > > > --
> > > > >
> > > > > Dave Peterson
> > > > >
> > >
> > > --
> > >
> > > Dave Peterson
> > >
>
> --
>
> Dave Peterson
>

Dave Peterson

12/16/2006 1:06:00 AM

0

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.

gwinder wrote:
>
> 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:
>
> > Maybe you should change this portion:
> >
> > if intersect(target,me.range("A1:AA175") is nothing then
> >
> > Does the event fire at all?
> >
> > gwinder wrote:
> > >
> > > 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" wrote:
> > >
> > > > 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
> > > >
> > > >
> > > >
> > > > gwinder wrote:
> > > > >
> > > > > 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" wrote:
> > > > >
> > > > > > 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%40t...
> > > > > >
> > > > > > 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?????
> > > > > >
> > > > > > gwinder wrote:
> > > > > > >
> > > > > > > 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
> > > > > > >
> > > > > > > gwinder@yamaha.com
> > > > > > >
> > > > > > > "Dave Peterson" wrote:
> > > > > > >
> > > > > > > > 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.)
> > > > > > > >
> > > > > > > >
> > > > > > > >
> > > > > > > > gwinder wrote:
> > > > > > > > >
> > > > > > > > > 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
> > > > > > > >
> > > > > > > > --
> > > > > > > >
> > > > > > > > Dave Peterson
> > > > > > > >
> > > > > >
> > > > > > --
> > > > > >
> > > > > > Dave Peterson
> > > > > >
> > > >
> > > > --
> > > >
> > > > Dave Peterson
> > > >
> >
> > --
> >
> > Dave Peterson
> >

--

Dave Peterson

gwinder

12/16/2006 1:41:00 AM

0

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?

Thanks,

Gary

"Dave Peterson" wrote:

> 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.
>
> gwinder wrote:
> >
> > 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:
> >
> > > Maybe you should change this portion:
> > >
> > > if intersect(target,me.range("A1:AA175") is nothing then
> > >
> > > Does the event fire at all?
> > >
> > > gwinder wrote:
> > > >
> > > > 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" wrote:
> > > >
> > > > > 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
> > > > >
> > > > >
> > > > >
> > > > > gwinder wrote:
> > > > > >
> > > > > > 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" wrote:
> > > > > >
> > > > > > > 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%40t...
> > > > > > >
> > > > > > > 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?????
> > > > > > >
> > > > > > > gwinder wrote:
> > > > > > > >
> > > > > > > > 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
> > > > > > > >
> > > > > > > > gwinder@yamaha.com
> > > > > > > >
> > > > > > > > "Dave Peterson" wrote:
> > > > > > > >
> > > > > > > > > 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.)
> > > > > > > > >
> > > > > > > > >
> > > > > > > > >
> > > > > > > > > gwinder wrote:
> > > > > > > > > >
> > > > > > > > > > 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
> > > > > > > > >
> > > > > > > > > --
> > > > > > > > >
> > > > > > > > > Dave Peterson
> > > > > > > > >
> > > > > > >
> > > > > > > --
> > > > > > >
> > > > > > > Dave Peterson
> > > > > > >
> > > > >
> > > > > --
> > > > >
> > > > > Dave Peterson
> > > > >
> > >
> > > --
> > >
> > > Dave Peterson
> > >
>
> --
>
> Dave Peterson
>

Dave Peterson

12/16/2006 1:54:00 AM

0

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



gwinder wrote:
>
> 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?
>
> Thanks,
>
> Gary
>
> "Dave Peterson" wrote:
>
> > 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.
> >
> > gwinder wrote:
> > >
> > > 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:
> > >
> > > > Maybe you should change this portion:
> > > >
> > > > if intersect(target,me.range("A1:AA175") is nothing then
> > > >
> > > > Does the event fire at all?
> > > >
> > > > gwinder wrote:
> > > > >
> > > > > 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" wrote:
> > > > >
> > > > > > 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
> > > > > >
> > > > > >
> > > > > >
> > > > > > gwinder wrote:
> > > > > > >
> > > > > > > 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" wrote:
> > > > > > >
> > > > > > > > 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%40t...
> > > > > > > >
> > > > > > > > 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?????
> > > > > > > >
> > > > > > > > gwinder wrote:
> > > > > > > > >
> > > > > > > > > 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
> > > > > > > > >
> > > > > > > > > gwinder@yamaha.com
> > > > > > > > >
> > > > > > > > > "Dave Peterson" wrote:
> > > > > > > > >
> > > > > > > > > > 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.)
> > > > > > > > > >
> > > > > > > > > >
> > > > > > > > > >
> > > > > > > > > > gwinder wrote:
> > > > > > > > > > >
> > > > > > > > > > > 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
> > > > > > > > > >
> > > > > > > > > > --
> > > > > > > > > >
> > > > > > > > > > Dave Peterson
> > > > > > > > > >
> > > > > > > >
> > > > > > > > --
> > > > > > > >
> > > > > > > > Dave Peterson
> > > > > > > >
> > > > > >
> > > > > > --
> > > > > >
> > > > > > Dave Peterson
> > > > > >
> > > >
> > > > --
> > > >
> > > > Dave Peterson
> > > >
> >
> > --
> >
> > Dave Peterson
> >

--

Dave Peterson

gwinder

12/16/2006 2:07:00 PM

0

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?

Thanks,

Gary

"Dave Peterson" wrote:

> 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
>
>
>
> gwinder wrote:
> >
> > 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?
> >
> > Thanks,
> >
> > Gary
> >
> > "Dave Peterson" wrote:
> >
> > > 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.
> > >
> > > gwinder wrote:
> > > >
> > > > 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:
> > > >
> > > > > Maybe you should change this portion:
> > > > >
> > > > > if intersect(target,me.range("A1:AA175") is nothing then
> > > > >
> > > > > Does the event fire at all?
> > > > >
> > > > > gwinder wrote:
> > > > > >
> > > > > > 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" wrote:
> > > > > >
> > > > > > > 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
> > > > > > >
> > > > > > >
> > > > > > >
> > > > > > > gwinder wrote:
> > > > > > > >
> > > > > > > > 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" wrote:
> > > > > > > >
> > > > > > > > > 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%40t...
> > > > > > > > >
> > > > > > > > > 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?????
> > > > > > > > >
> > > > > > > > > gwinder wrote:
> > > > > > > > > >
> > > > > > > > > > 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
> > > > > > > > > >
> > > > > > > > > > gwinder@yamaha.com
> > > > > > > > > >
> > > > > > > > > > "Dave Peterson" wrote:
> > > > > > > > > >
> > > > > > > > > > > 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.)
> > > > > > > > > > >
> > > > > > > > > > >
> > > > > > > > > > >
> > > > > > > > > > > gwinder wrote:
> > > > > > > > > > > >
> > > > > > > > > > > > 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
> > > > > > > > > > >
> > > > > > > > > > > --
> > > > > > > > > > >
> > > > > > > > > > > Dave Peterson
> > > > > > > > > > >
> > > > > > > > >
> > > > > > > > > --
> > > > > > > > >
> > > > > > > > > Dave Peterson
> > > > > > > > >
> > > > > > >
> > > > > > > --
> > > > > > >
> > > > > > > Dave Peterson
> > > > > > >
> > > > >
> > > > > --
> > > > >
> > > > > Dave Peterson
> > > > >
> > >
> > > --
> > >
> > > Dave Peterson
> > >
>
> --
>
> Dave Peterson
>