View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
steve steve is offline
external usenet poster
 
Posts: 576
Default Merged Cells Autofit - code amendment

Roy,

I played with Tom's code in Excel97 and made some minor changes.
It will now work provided your merged cells are on the same row ONLY.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("80:91,100:105")) Is Nothing Then

Application.EnableEvents = False
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If Target.MergeCells Then
With Target
If .Rows.Count = 1 Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = Target.ColumnWidth
For Each CurrCell In Target
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Application.EnableEvents = True
End If
End Sub


--
sb
"roy" wrote in message
om...
Hi Tom,

That didn't work for me either,(don't know why, but it just sat there
doing nothing), although nothing came up to say it wasn't working
either (i.e. a "bug" report). Have included a slightly emended version
of my initial query below if this helps clarify things at all ?

Many thanks Tom :))



Sorry if this has been posted before, but have spent a fair bit of
time searching through the google pages, but didn't find quite the
right thing :)

I have a worksheet, which is about 4-5 pages long in total, that is
set to take all sorts of data entries (both numeric and text) that are
going to be anything from a 2-3 word entry up to quite a lengthy
string of words. The users entering this data will be using the "Alt +
Enter" method to simulate a carraige return. The problem I am having
is that the sheet needs to hold some form of "presentable" format when
either printed or viewed on screen and as such have had to set the row
heights to a uniform measurement to ensure a presence (albeit a rather
dubious one)of professionalism on the users behalf.

When all of their entries are fairly small (perhaps there are only two
or three lines of data in a cell) there is no problem as the end
result looks good (all cells aligned , centred, e.t.c.)but as soon as
they go "over the limit" of the set row height, the rest of the text
is then hiden under the cell border of the next cell below it.

Is there any way that I can use a macro that will automatically
correct the row height (perhaps as soon as the user hits "enter" to go
to the next cell), so that those cells, and those cells only, that due
to the quantity of text entered need to exceed the pre-set height (say
size 36 for example), will automatically be adjusted to a row height
that then shows all data entered ?

Due to the nature of the sheet itself and the numeric data in other
cells higher up the sheet, I need this to happen to only 2 specific
"ranges" of rows (for example rows 80 to 91 inclusive and for rows 100
to 105 inclusive).

Would like to express my most sincerest thanks in advance for any help
that you may be able to give with this headache.


Best regards,
Roy.






"Tom Ogilvy" wrote in message

...
Right click on the worksheet where you want this behavior and paste in

code
such as this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("80:91,100:105")) Is Nothing Then

Application.EnableEvents = False
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If Target.MergeCells Then
With Target.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = Target.ColumnWidth
For Each CurrCell In Target.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Application.EnableEvents = True
End If
End Sub

--
Regards,
Tom Ogilvy


<snip