RowHeight and AutoFit wit Merged Cells

[Howard Kaikow]

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

 

[Howard Kaikow]

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

 

[Greg Wilson]

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

 

[Peter T]

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]

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.

 

[Howard Kaikow]

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.

 

[Howard Kaikow]

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]

The code explicitly limits itself to 1 row,

It appears to be limited to one cell.

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.

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.

I had thought about doing that.


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]

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]

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]

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.

 

[Peter T]

It is doing the MergeArea in which the cell lives.

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

 

[Howard Kaikow]

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 had a version that used a single cell, but that would be inefficient, as
I already know the merge area.

 

[Howard Kaikow]

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]

When you run the code, are you running via VB 6, or are you running in
Excel?

 

[Howard Kaikow]

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.

 

[Peter T]

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

 

[Peter T]

When you run the code, are you running via VB 6, or are you running in
Excel?

In Word. I 've just repeated in VB6 and got similar timings. However, seems
it depends on what you are doing as to whether there's a significant speed
gain with screenupdating disabled when excel is not visible.

Try the following in Word or VB6 and have a cup of coffee, or even a glass
of OJ. For me a significant saving with bAutoFitTest = false but not much in
the second loop when bAutoFitTest = True

Option Explicit
Sub xlScrnUpdate()
Dim bAutoFitTest As Boolean
Dim i As Long
Dim t As Single
Dim oRng As Object
Dim oWS As Object
Dim xlApp As Object

Set xlApp = CreateObject("excel.application")
Set oWS = xlApp.workbooks.Add.worksheets(1)

For i = 0 To 1

bAutoFitTest = i = 1
Debug.Print bAutoFitTest

xlApp.Visible = False
xlApp.ScreenUpdating = True
testStuff oWS, bAutoFitTest

xlApp.ScreenUpdating = False
testStuff oWS, bAutoFitTest

xlApp.Visible = True
xlApp.ScreenUpdating = True
testStuff oWS, bAutoFitTest

xlApp.ScreenUpdating = False
testStuff oWS, bAutoFitTest
Next
xlApp.ScreenUpdating = True

Stop

oWS.Parent.Close 0
Set oWS = Nothing
xlApp.Quit
Set xlApp = Nothing
Unload Me

End Sub

Sub testStuff(oWS As Object, bColWidth As Boolean)
Dim i As Long, qty As Long
Dim t As Single

If bColWidth Then qty = 2000 Else qty = 10000

oWS.Cells.clearcontents
With oWS.Columns(1)
.columnwidth = .Parent.standardwidth
t = Timer
For i = 1 To qty
.Cells(i, 1) = i & " some text longish text " & i
If bColWidth Then
.entirecolumn.AutoFit
End If
Next
End With
t = Timer - t
Debug.Print t
End Sub

Private Sub Form_Load()
xlScrnUpdate
End Sub

Regards,
Peter T

 

[Howard Kaikow]

Ah, you are aitomating Excel from Word.
That is likely significantly different than automating from VB 6.

Not to mention AV software might poke its nose in differently.

Also, I forget to mention that while I am running my "real" program, I
outputing progress both
to a listbox and a text file.

However, the latest version of hte code, used inline, rather than via sub,
eliminates a lot of the overhead, e.g., it does not do the mergearea until
after everything else is done, and uses a Union which is clearly faster.

In my original example, I was processing 1 chunk at a time, moving down a
column.
In the "real" program, I've changed that to process along rows.

Code snippett is given below.

In Word. I 've just repeated in VB6 and got similar timings. However, seems
it depends on what you are doing as to whether there's a significant speed
gain with screenupdating disabled when excel is not visible.

I did extensive testing of Screenupdating in Word over the years, there is a
significant
improvement, using the Range object with Word, more so if SCreenupdating is
not enabled.
Of course the document is not visible.

IN my case, enabling screenupdaing adversely affects performance, no need to
test otherwise.

k = count Mod PerRow
'If symbols are used, no need to adjust rowheight
If Not bUseSymbols Then
Select Case k
Case 1
Set rng = .Offset(r, 0)
Case 2
Set rng = Union(.Offset(r, 0), .Offset(r, 2))
Case 3
Set rng = Union(.Offset(r, 0), .Offset(r, 2),
..Offset(r, 4))
Case 4
Set rng = Union(.Offset(r, 0), .Offset(r, 2),
..Offset(r, 4), .Offset(r, 6))
End Select
SourceWidth = .Offset(r, 0).Columns(1).ColumnWidth
MergedAreaWidth = 2 * SourceWidth
With rng
.ColumnWidth = MergedAreaWidth
.WrapText = vbTrue
With .Rows(1)
.EntireRow.AutoFit
.RowHeight = .RowHeight
End With
.ColumnWidth = SourceWidth
End With
End If
For j = 1 To k
n = (j - 1) * 2 ' I yam merging 2 cells
.Application.Range(.Offset(r, n), .Offset(r, n +
1)).MergeCells = vbTrue
Next j

 

[Peter T]

Ah, you are aitomating Excel from Word.
That is likely significantly different than automating from VB 6.

Like I said, not significantly different at all in Word vs VB6, in fact very
similar as I would have expected. Some things of course work faster in
compiled VB, though not much difference working with excel objects, even in
the IDE (FWIW I've noticed an in process dll can be faster, even than the
same dll used as a Com addin).

Not to mention AV software might poke its nose in differently.

No idea about that.

Also, I forget to mention that while I am running my "real" program, I
outputing progress both
to a listbox and a text file.

However, the latest version of hte code, used inline, rather than via sub,
eliminates a lot of the overhead, e.g., it does not do the mergearea until
after everything else is done, and uses a Union which is clearly faster.

In my original example, I was processing 1 chunk at a time, moving down a
column.
In the "real" program, I've changed that to process along rows.

Code snippett is given below.

I take it you didn't try the litte test I posted (which demonstrates the
gain to be had by disabling screenupdating in an invisible instance depends
on what you are doing to sheet and cells). Your snippet is sort of simlar to
the second of my two tests which showed only a small gain to be had by
disabling screenupdating in an invisible instance.

I did extensive testing of Screenupdating in Word over the years, there is a
significant
improvement, using the Range object with Word, more so if SCreenupdating is
not enabled.
Of course the document is not visible.

I didn't test anything relating to Word and Word's Range object, other than
automating Excel in Word.

IN my case, enabling screenupdaing adversely affects performance, no need to
test otherwise.

Of course go with whatever works best with your overall scenario. Just
looking at the snippet below I'd bet it would be a tad faster with
screenupdating disabled in an invisible instance. Other things you are doing
might negate that.