View Single Post
 
Old 09-16-2011, 07:10 AM
OTPM OTPM is offline Windows 7 32bit Office 2010 32bit
Expert
 
Join Date: Apr 2011
Location: West Midlands
Posts: 981
OTPM is on a distinguished road
Default Help with VBA Code Modification

Hi All
I am looking for some help with modifying the vba code below. The code was kindly donated by another forum member adn I cannot remember who it was. However what I need is for the code not to run unless the text in an Excel cell exceeds the width of the cell.
When the text exceeds the width of the cell it works fine.
Any help would be appreciated:

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

Tony (OTPM)
Reply With Quote