I've seen a number of posts here and there that it is possible create one's
auto fit for
merged cells in a row to adjust cell height,

The logic is straightforward, but the execution is very slow.

Granted, I am using a 10 year old computer.
Yes, I will get another computer, indeed, I intend to build the critter and
purchased Win XP Pro SP@ on 15 April.

In any case, any ideas on how to speed up the code below.
On my old PC, it takes about 1 second to exceute the code for a cell merged
area.

Private Sub AutoFitMergeArea(rngSource As Excel.Range)
' Performs row height autofit for the MergeArea
' including rngSource

' Range must contain only 1 row.
' WrapText must be set to True.

' Row height is not reduced because other cells in the same row
' may need a greater height.

Dim MergedAreaWidth As Single
Dim NewRowHeight As Single
Dim rngCell As Excel.Range
Dim SourceWidth As Single
Dim SourceRowHeight As Single

With rngSource
If .MergeCells Then
MergedAreaWidth = 0#
SourceWidth = .Columns(1).ColumnWidth
If .Rows.count = 1 And .WrapText Then
SourceRowHeight = .RowHeight
For Each rngCell In rngSource
MergedAreaWidth = rngCell.ColumnWidth + MergedAreaWidth
Next rngCell
.MergeCells = vbFalse
.Cells(1).ColumnWidth = MergedAreaWidth
.EntireRow.AutoFit
NewRowHeight = .RowHeight
.Cells(1).ColumnWidth = SourceWidth
.MergeCells = vbTrue
If SourceRowHeight NewRowHeight Then
.RowHeight = SourceRowHeight
Else
.RowHeight = NewRowHeight
End If
End If
End If
End With
Set rngCell = Nothing
End Sub

Corrections

Granted, I am using a 10 year old computer.
Yes, I will get another computer, indeed, I intend to build the critter
and
purchased Win XP Pro SP@ on 15 April.

SP@ should be SP2.

In any case, any ideas on how to speed up the code below.
On my old PC, it takes about 1 second to exceute the code for a cell
merged
area.

"cell merged" should be "2 cell merged".

The posted code is missing "Application.ScreenUpdating = False" at the
beginning and "Application.ScreenUpdating = True" at the end. Since you
implied you understand the code, I'll let you decide where to insert the
lines.

Greg

"Howard Kaikow" wrote:

I've seen a number of posts here and there that it is possible create one's
auto fit for
merged cells in a row to adjust cell height,

The logic is straightforward, but the execution is very slow.

Granted, I am using a 10 year old computer.
Yes, I will get another computer, indeed, I intend to build the critter and
purchased Win XP Pro SP@ on 15 April.

In any case, any ideas on how to speed up the code below.
On my old PC, it takes about 1 second to exceute the code for a cell merged
area.

Private Sub AutoFitMergeArea(rngSource As Excel.Range)
' Performs row height autofit for the MergeArea
' including rngSource

' Range must contain only 1 row.
' WrapText must be set to True.

' Row height is not reduced because other cells in the same row
' may need a greater height.

Dim MergedAreaWidth As Single
Dim NewRowHeight As Single
Dim rngCell As Excel.Range
Dim SourceWidth As Single
Dim SourceRowHeight As Single

With rngSource
If .MergeCells Then
MergedAreaWidth = 0#
SourceWidth = .Columns(1).ColumnWidth
If .Rows.count = 1 And .WrapText Then
SourceRowHeight = .RowHeight
For Each rngCell In rngSource
MergedAreaWidth = rngCell.ColumnWidth + MergedAreaWidth
Next rngCell
.MergeCells = vbFalse
.Cells(1).ColumnWidth = MergedAreaWidth
.EntireRow.AutoFit
NewRowHeight = .RowHeight
.Cells(1).ColumnWidth = SourceWidth
.MergeCells = vbTrue
If SourceRowHeight NewRowHeight Then
.RowHeight = SourceRowHeight
Else
.RowHeight = NewRowHeight
End If
End If
End If
End With
Set rngCell = Nothing
End Sub

"Greg Wilson" wrote in message
...
The posted code is missing "Application.ScreenUpdating = False" at the
beginning and "Application.ScreenUpdating = True" at the end. Since you
implied you understand the code, I'll let you decide where to insert the
lines.

Actually, I do have the code, but it is commented out.
Code is not necessary, as Excel will not be visible.

Actually the logic is not straightforward if you need to deal with
mergearea's that contain both multiple columns and rows. That aside, the
code you posted could be improved though only to small effect compared with
what will always be the reletively slow step of re-merging. However your
code as posted fails to do that, unless I understand the purpose I assume
that's an oversite.

I did try your function and in my (I guess) equally old system it took an
eyeblink. If it took a second in yours there's something else going on.

If you have many potential mergeareas to autofit it would be very
significantly faster to process on another sheet and not need to do
re-merge's at all. Here's an example that gives you the option to do it both
ways, note the process is an entire row at a time. Watch out wrap'd code

Option Explicit
Sub test()
Dim cel As Range
Dim ws As Worksheet
Dim t As Single
t = Timer

Application.ScreenUpdating = False
For Each cel In Selection.Columns(1).Cells
'only send one cell per row
AutoFitMergeRow cel, False, ws
Next

If Not ws Is Nothing Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = False
End If
Application.ScreenUpdating = True
Debug.Print Timer - t ' res about 1/18 sec
End Sub

Sub AutoFitMergeRow(rSource As Range, bInPlace As Boolean, Optional wsDummy
As Worksheet)
Dim bDelDummy As Boolean
Dim bScrUDate As Boolean
Dim i As Long, j As Long, k As Long, cc As Long, w As Single, rw As Long
Dim rng As Range, cel As Range, rSourceRow As Range
Dim shtOrig As Object
Dim nTop As Long, nBot As Long
Dim arMA() As Range


bScrUDate = Application.ScreenUpdating
Set rSourceRow = rSource(1).EntireRow.Cells

If Not IsNull(rSourceRow.MergeCells) Then
rSource.Rows(1).AutoFit ' no merged cells
Else

If Not bInPlace Then
If wsDummy Is Nothing Then
With rSource.Parent.Parent
On Error Resume Next
Set wsDummy = .Worksheets("Dummy")
On Error GoTo 0
If wsDummy Is Nothing Then
bDelDummy = IsMissing(wsDummy)

Set wsDummy =
..Worksheets.Add(after:=.Sheets(.Sheets.Count))
wsDummy.Name = "Dummy"
rSource.Parent.Activate

End If
End With
End If

Set rng = wsDummy.Rows(1).Cells

' NOTE this fails to copy if the
' contains merged areas in rows
rSourceRow.Cells.Copy rng

End If

If bInPlace Then
Set rng = Intersect(rSourceRow.Parent.UsedRange,
rSourceRow.Cells)
Else
Set rng = Intersect(wsDummy.UsedRange, rng.Cells)
End If


If Not rng Is Nothing Then
i = rng.Columns(1).Column - 1

ReDim aw(i To rng.Columns.Count + i)
If bInPlace Then
ReDim arMA(i To UBound(aw)) As Range
End If

For Each cel In rng
If cel.Column i Then

cc = cel.MergeArea.Columns.Count

If cc 1 Then
If cel.Address = cel.MergeArea(1).Address Then

w = 0
If bInPlace Then
aw(i) = cel.ColumnWidth
Set arMA(i) = cel.MergeArea
End If

For j = 1 To cc
w = w + rSourceRow.Cells(1, i +
j).ColumnWidth
Next
cel.ColumnWidth = w

End If
End If
i = i + cc
' Else
' 'skip other cells in mergearea
End If

Next

rng.MergeCells = False
End If

If Not bInPlace Then
wsDummy.Rows(1).AutoFit
rSource.RowHeight = wsDummy.Rows(1).RowHeight

wsDummy.Rows(1).Clear
wsDummy.Rows(1).EntireRow.Delete
Else
rSource.Rows(1).AutoFit
For i = LBound(aw) To UBound(aw)
k = k + 1
If Not arMA(i) Is Nothing Then
rng(k).ColumnWidth = aw(i)
arMA(i).Merge
End If
Next
End If
End If
Application.ScreenUpdating = bScrUDate
End Sub

In my ancient setup time to process 10 rows each containing 50 mergeareas
each with several lines of text (a mixture and wordwrap'd), took 0.828125
seconds in total.

Note as written the above does not cater for mergeareas that include
multiple rows.

Regards,
Peter T


"Howard Kaikow" wrote in message
...
I've seen a number of posts here and there that it is possible create
one's
auto fit for
merged cells in a row to adjust cell height,

The logic is straightforward, but the execution is very slow.

Granted, I am using a 10 year old computer.
Yes, I will get another computer, indeed, I intend to build the critter
and
purchased Win XP Pro SP@ on 15 April.

In any case, any ideas on how to speed up the code below.
On my old PC, it takes about 1 second to exceute the code for a cell
merged
area.

Private Sub AutoFitMergeArea(rngSource As Excel.Range)
' Performs row height autofit for the MergeArea
' including rngSource

' Range must contain only 1 row.
' WrapText must be set to True.

' Row height is not reduced because other cells in the same row
' may need a greater height.

Dim MergedAreaWidth As Single
Dim NewRowHeight As Single
Dim rngCell As Excel.Range
Dim SourceWidth As Single
Dim SourceRowHeight As Single

With rngSource
If .MergeCells Then
MergedAreaWidth = 0#
SourceWidth = .Columns(1).ColumnWidth
If .Rows.count = 1 And .WrapText Then
SourceRowHeight = .RowHeight
For Each rngCell In rngSource
MergedAreaWidth = rngCell.ColumnWidth +
MergedAreaWidth
Next rngCell
.MergeCells = vbFalse
.Cells(1).ColumnWidth = MergedAreaWidth
.EntireRow.AutoFit
NewRowHeight = .RowHeight
.Cells(1).ColumnWidth = SourceWidth
.MergeCells = vbTrue
If SourceRowHeight NewRowHeight Then
.RowHeight = SourceRowHeight
Else
.RowHeight = NewRowHeight
End If
End If
End If
End With
Set rngCell = Nothing
End Sub

"Peter T" <peter_t@discussions wrote in message
...
Actually the logic is not straightforward if you need to deal with
mergearea's that contain both multiple columns and rows.

The code explicitly limits itself to 1 row,

That aside, the
code you posted could be improved though only to small effect compared
with
what will always be the reletively slow step of re-merging. However your
code as posted fails to do that, unless I understand the purpose I assume
that's an oversite.

I do not understand the above comment.

I did try your function and in my (I guess) equally old system it took an
eyeblink. If it took a second in yours there's something else going on.

Mine is really 10 years old, Pentium II 400 mhz.

Hmmm, I wonder if the AV software is interfering.
After I get off the internet, I'll disable the AV and see what happens.

If you have many potential mergeareas to autofit it would be very
significantly faster to process on another sheet and not need to do
re-merge's at all.

I had thought about doing that.

Here's an example that gives you the option to do it both
ways, note the process is an entire row at a time. Watch out wrap'd code

At this time, I am not processing a row at a time, rather 2 merged cells at
a time.
I may process a row at a time after I decide the final layout of the cells.

The AV software does play a part in the absolute time.

But the relative time increase when adjusting for row height
appears to be quite similar whether or not the AV is enabled..

Running the program from a .exe.

With AV disabled:
No adjustment for row height: 19 seconds
Adjustment for row height: 36 seconds


With AV Enabled:
No adjustment for Row height: 25 seconds
No adjustment for row height: 24 seconds

Adjustment for Row height: 50 seconds
Adjustment for row height: 47 seconds

I didn't see this when I posted a few minutes ago. I wonder if the
differences with AV enabled/disabled relates to AV doing it's own thing in
the background, or directly poking its nose into what you are doing.

I don't know what you are processing but whatever it is it seems like a very
long time.

Regards,
Peter T

"Howard Kaikow" wrote in message
...
The AV software does play a part in the absolute time.

But the relative time increase when adjusting for row height
appears to be quite similar whether or not the AV is enabled..

Running the program from a .exe.

With AV disabled:
No adjustment for row height: 19 seconds
Adjustment for row height: 36 seconds


With AV Enabled:
No adjustment for Row height: 25 seconds
No adjustment for row height: 24 seconds

Adjustment for Row height: 50 seconds
Adjustment for row height: 47 seconds

"Peter T" <peter_t@discussions wrote in message
...
I didn't see this when I posted a few minutes ago. I wonder if the
differences with AV enabled/disabled relates to AV doing it's own thing in
the background, or directly poking its nose into what you are doing.

Sigh, I just checke the AV log file.
Alas, it refreshed the event log shortly after I ran the program, so I
cannot what events were going on in the AV.


I don't know what you are processing but whatever it is it seems like a
very
long time.

Yes, sumptin's not right.

I may try this with Excel 97, 2000 and 2002 to see if the same behavior is
exhibited.

"Howard Kaikow" wrote in message
...
"Peter T" <peter_t@discussions wrote in message
...
Actually the logic is not straightforward if you need to deal with
mergearea's that contain both multiple columns and rows.

The code explicitly limits itself to 1 row,

It appears to be limited to one cell.


That aside, the
code you posted could be improved though only to small effect compared
with
what will always be the reletively slow step of re-merging. However your
code as posted fails to do that, unless I understand the purpose I
assume
that's an oversite.

I do not understand the above comment.

Maybe it's me that doesn't understand the purpose of your code. I assumed
the idea was to size a row height to the "autofit" height of a mergearea
consisting of two or more cells in a row (subject not making the row height
less than it was). But your code doesn't do that at all. Instead it unmerges
the mergarea, does not resize the width of cell(1) to the original mergearea
width, then autofits row height, does not re-merge the original mergearea.
If that's the intention I don't get it.


I did try your function and in my (I guess) equally old system it took
an
eyeblink. If it took a second in yours there's something else going on.

Mine is really 10 years old, Pentium II 400 mhz.

The one I tested on is similar but a tad slower, PII 350.

Hmmm, I wonder if the AV software is interfering.
After I get off the internet, I'll disable the AV and see what happens.

I'd be alarmed to think AV might make such a difference, hope it's not that.

If you have many potential mergeareas to autofit it would be very
significantly faster to process on another sheet and not need to do
re-merge's at all.

I had thought about doing that.

Here's an example that gives you the option to do it both
ways, note the process is an entire row at a time. Watch out wrap'd code

At this time, I am not processing a row at a time, rather 2 merged cells
at
a time.
I may process a row at a time after I decide the final layout of the
cells.

Why not try the example I posted with a large number of cells in multiple
rows. Select cells in a column that intersects those rows and run as is.

In your reply to Greg you say you don't disable screenupdating as the
instance is not visible. Even not visible it's still worth disabling.

Regards,
Peter T

"Peter T" <peter_t@discussions wrote in message
...
It appears to be limited to one cell.
It is doing the MergeArea in which the cell lives.

Maybe it's me that doesn't understand the purpose of your code. I assumed
the idea was to size a row height to the "autofit" height of a mergearea
consisting of two or more cells in a row (subject not making the row
height
less than it was).

Yes.

But your code doesn't do that at all. Instead it unmerges
the mergarea, does not resize the width of cell(1) to the original
mergearea
width, then autofits row height, does not re-merge the original mergearea.
If that's the intention I don't get it.

The code is doing the intended deed.
It unmerges so it can set the width of col 1 to the width of the original
col 1 + col 2;
Then it does an AutoFit with the unmereged cells.
then it sets the rowheight.
then it sets the width of column 1 back to the original width, then it
merges,
and, adjusts the row height.

The one I tested on is similar but a tad slower, PII 350.

This is a multibbot system, I'll boot to an OS with Excel 97, but first
gotta have some OJ, etc.!

In your reply to Greg you say you don't disable screenupdating as the
instance is not visible. Even not visible it's still worth disabling.


I tried Screenupdating, as expected, with a non-visible wbk, may actually
have slowed down things.

"Howard Kaikow" wrote in message
...
"Peter T" <peter_t@discussions wrote in message
...
It appears to be limited to one cell.
It is doing the MergeArea in which the cell lives.

<snip

The code is doing the intended deed.
It unmerges so it can set the width of col 1 to the width of the original
col 1 + col 2;
Then it does an AutoFit with the unmereged cells.
then it sets the rowheight.
then it sets the width of column 1 back to the original width, then it
merges,
and, adjusts the row height.

OK I get it now, it works as you say providing the entire MergeArea is
passed to the function (which means of course you need to know in advance
it's full meargearea) or pass say activecell.mergearea. Previously I had
only been passing a single cell and so it didn't do as expected.

I tried Screenupdating, as expected, with a non-visible wbk, may actually
have slowed down things.

I did a quick test of timings writing text to a lot of cells in an automated
instance.

xlapp.visible = false
47.51172 SU=True
40.48047 SU=False

xlapp.visible = true
65.1875 SU=True
40.32031 SU=False

time in seconds, SU refers to screenupdating)

Regards,
Peter T

Now that I've modified the code to work on all RELEVANT cells with a row,
I can get a great increase in speed by doing the following:

1. Do NOT wrap or merge cells vefore calling the code.
2. Work off of only the first cell in the range that is to be merged.

I was wondering whether using a Union, as below, is faster.
I need to, perhaps, tweak the code for handling less than 4 critters
in a row.

with SomeRangeObject
' If Union is faster, then other tweaks can be made below.
Set rng = Union(.Offset(r, 0), .Offset(r, 2), .Offset(r, 4),
..Offset(r, 6))
' The following is not needed as I am creating the workbook
anew.
' SourceRowHeight = .RowHeight
'The following is really a constant for the entire workbook
being created anew.
SourceWidth = .Offset(r, 0).Columns(1).ColumnWidth
MergedAreaWidth = 2 * SourceWidth
rng.ColumnWidth = MergedAreaWidth
' .Offset(r, 0).ColumnWidth = MergedAreaWidth
' .Offset(r, 2).ColumnWidth = MergedAreaWidth
' .Offset(r, 4).ColumnWidth = MergedAreaWidth
' .Offset(r, 6).ColumnWidth = MergedAreaWidth
rng.WrapText = vbTrue
' .Offset(r, 0).WrapText = vbTrue
' .Offset(r, 2).WrapText = vbTrue
' .Offset(r, 4).WrapText = vbTrue
' .Offset(r, 6).WrapText = vbTrue
' .Offset(r, 0).EntireRow.AutoFit
NewRowHeight = .Offset(r, 0).Rows(1).RowHeight
rng.ColumnWidth = SourceWidth
' .Offset(r, 0).ColumnWidth = SourceWidth
' .Offset(r, 2).ColumnWidth = SourceWidth
' .Offset(r, 4).ColumnWidth = SourceWidth
' .Offset(r, 6).ColumnWidth = SourceWidth
For new w orkbook, not an issue.
' If SourceRowHeight NewRowHeight Then
' .Offset(r, 0).Rows(1).RowHeight = SourceRowHeight
' Else
.Offset(r, 0).Rows(1).RowHeight = NewRowHeight
' End If
.Application.Range(.Offset(r, 0), .Offset(r, 1)).MergeCells
= vbTrue
.Application.Range(.Offset(r, 2), .Offset(r, 3)).MergeCells
= vbTrue
.Application.Range(.Offset(r, 4), .Offset(r, 5)).MergeCells
= vbTrue
.Application.Range(.Offset(r, 6), .Offset(r, 7)).MergeCells
= vbTrue
End With

"Howard Kaikow" wrote in message
...
I was wondering whether using a Union, as below, is faster.

Using a sample size of 1 run, Union is much faster, 30 seconds rather than
39 seconds.

"Howard Kaikow" wrote in message
...
"Howard Kaikow" wrote in message
...
I was wondering whether using a Union, as below, is faster.

Using a sample size of 1 run, Union is much faster, 30 seconds rather than
39 seconds.

Difficult to comment without context of what you are doing overall. I take
it you are processing a lot of cells.

Union is pretty quick with a small number of areas but rapidly becomes
exponentially slower with more. Note it is the number of resulting areas
rather than number of unions that's relevant. It's a little bit faster to
make a multi-area range with an address. Limited to 255 characters or say 16
multcell areas located anywhere on the sheet and $'s trimmed (would need to
recalc the max safe qty in xl2007). All this is of little consequence with
only four areas as you appear to have. Except of course having built the
multi area it's then faster to work with rather than each individual area,
as you have found.

There's a difference in how the range is made with address vs union which
might be of relevance to you (apart from small speed gain). Namely you can
build adjacent multi-areas. So for your purposes you could replace four
MergeCells = True, that relate to adjacent areas, with just one mergecells =
true. If that doesn't make sense I'll post an example.

I can't help but wonder if your current 30 seconds might much less. Guess it
depends on what you are doing.

Regards,
Peter T

FYI, .I finally replaced Union with Areas.

Time was cut in about half.

Tho, I now have to find out the string limits for Areas in each version of
Excel

"Howard Kaikow" wrote in message
FYI, .I finally replaced Union with Areas.

Time was cut in about half.

I'd be surprised if it replacing Union with Address alone cut your time in
half, but for sure doing multiple merge's in one go would have helped. I had
some range related code that took some minutes to complete. It was a matter
of chippping away and eventually time was reduced to just a few seconds.
However what was once a few lines became several hundred to do the same
thing.

Tho, I now have to find out the string limits for Areas in each version of
Excel

Len("AA12345:AB12345,") = 16
16 x 16 less one comma = 255

Address limit is 255 in '97 to 2003, up to 16 areas anywhere on the sheet.

I don't know what it is in 2007, probably also 255. However due to increased
sheet size a single area address length can be longer, and the 'safe' number
of areas less.

Regards,
Peter T