View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Gord Dibben[_2_] Gord Dibben[_2_] is offline
external usenet poster
 
Posts: 621
Default Calling module procedure from sheet procedure

This Greg Wilson worksheet event code does the trick.

Just make sure merged cells are pre-formatted to wrap text.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
With Target
If .MergeCells And .WrapText 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 With
End Sub


Gord




On Thu, 19 Jun 2014 17:23:29 +0100, EricLCTCS
wrote:


Newbie non developer here...

I have created a procedure "AutoFitMergedCellRowHeight()" in Module1
that I can manually run against a field in a spreadsheet that that
successfully resizes a cell height depending on the amount of text
entered:

Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range, RangeWidth As Single

Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
RangeWidth = .Width

For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth +
MergedCellRgWidth
Next
MergeCells = False
Cells(1).ColumnWidth = MergedCellRgWidth
While .Cells(1).Width < RangeWidth
Cells(1).ColumnWidth = .Cells(1).ColumnWidth + 0.5
Wend
Cells(1).ColumnWidth = .Cells(1).ColumnWidth - 0.5

EntireRow.AutoFit
PossNewRowHeight = .RowHeight
Cells(1).ColumnWidth = ActiveCellWidth
MergeCells = True
RowHeight = IIf(CurrentRowHeight PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub


I have also created a procedure under Sheet4:

Sub Worksheet_Change(ByVal Target As Range)

'MsgBox "You just changed " & Target.Address
Call Module1.AutoFitMergedCellRowHeight

End Sub

I effective want a cell to automatically resize itself after the cell
value has changed.

The manually triggered resize works fine but the auto resize does not.

Any insight would be appreciated.

EricLCTCS