Autofit of Row Height with Merged Cells - AGAIN!
 

I've read all the previous messages (and tried the examples) re how to do
this, but can't get them to work in my particular instance - keep getting
compile errors. My spreadsheet requires merged cells, so can't get around
not using them. (Am merging cells across columns, not merging rows down, and
wrapping all the text.)

The workbook contains multiple tabs. I want to be able to do the following:
1) Go from any cell on the tab titled 'Instructions' to the tab titled
'Assumptions'
2) Highlight every row on the 'Assumptions' tab
3) Wrap the text
4) Autofit all the row heights (note: all cells have already been
merged-macro does not need to do this)
5) Go back to cell A1 of the 'Instructions' tab.

Can someone please provide a macro to do this?
PS: I have Excel 2002 for XP. Also, I will be assigning this macro to a
button, using the Forms toolbar. Not sure if this makes any difference in
terms of how the macros is written - I don't think so but wanted to say so
just in case. THANKS!!!

Autofit of Row Height with Merged Cells - AGAIN!
 

Sheets("Assumptions").UsedRange.WrapText = True
Rows("1:" & Sheets
_("Assumptions").UsedRange.Rows.Count).EntireRow.A utoFit
Sheets("Instructions").Select
Range("A1").Select



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Autofit of Row Height with Merged Cells - AGAIN!
 

This is my third attempt to post this. The below macro was adapted from
a post by Jim Rech who, to my knowledge, originated this approach.

The following assumptions are made:
1) All the merged ranges start in column A.
2) Only columns are merged - i.e. each merged range involvles only one
row.
3) You don't actually need to activate sheet Assumptions nor select the
rows.

Note that the code will likely have to be adapted to your specific
situation. It won't activate sheet Assumptions nor highlight (select)
any rows. It is assumed that this isn't actually necessary. It works
whether sheet Assumptions is active or not.

Regards,
Greg

Sub AutoFitMergedRng()
Dim ws As Worksheet
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim rng As Range, ma As Range

Set ws = Sheets("Assumptions")
Set rng = Intersect(ws.UsedRange, ws.Columns(1))
Application.ScreenUpdating = False
For Each c In rng.Cells
If c.MergeArea.Count 1 Then
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
End If
cWdth = 0: MrgeWdth = 0
Next
Application.ScreenUpdating = True
End Sub




*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Autofit of Row Height with Merged Cells - AGAIN!
 

Thanks to both of you for responding! Claud, I can use your response in some
other spreadsheets; unfortunately, it did not work for this specific one
because of the merged cells. Greg, your solution worked perfectly for my
needs in this specific case. After weeks of struggling with this - you are a
lifesaver!!!!!! THANK YOU AGAIN TO BOTH OF YOU...

"Greg Wilson" wrote:

This is my third attempt to post this. The below macro was adapted from
a post by Jim Rech who, to my knowledge, originated this approach.

The following assumptions are made:
1) All the merged ranges start in column A.
2) Only columns are merged - i.e. each merged range involvles only one
row.
3) You don't actually need to activate sheet Assumptions nor select the
rows.

Note that the code will likely have to be adapted to your specific
situation. It won't activate sheet Assumptions nor highlight (select)
any rows. It is assumed that this isn't actually necessary. It works
whether sheet Assumptions is active or not.

Regards,
Greg

Sub AutoFitMergedRng()
Dim ws As Worksheet
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim rng As Range, ma As Range

Set ws = Sheets("Assumptions")
Set rng = Intersect(ws.UsedRange, ws.Columns(1))
Application.ScreenUpdating = False
For Each c In rng.Cells
If c.MergeArea.Count 1 Then
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
End If
cWdth = 0: MrgeWdth = 0
Next
Application.ScreenUpdating = True
End Sub




*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!