cleturno
01-23-2006, 09:15 AM
When the event is run it is running selectively and I don't know if it is me or excel? Any help would be greatly appreciated. I am trying to get the Autofit to skip when a change is made to formatting, deleting, or empty cells. The only problem is that it seems to work on some cells and on others it just misses. I am working with Office 2003 and Windows XP Prof.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value Is Nothing Then
Exit Sub
Else
Call AutoFitMergedCellRowHeight(Target)
End If
End Sub
Sub AutoFitMergedCellRowHeight(Cell As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If Cell.MergeCells Then
With Cell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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.ScreenUpdating = Ture
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value Is Nothing Then
Exit Sub
Else
Call AutoFitMergedCellRowHeight(Target)
End If
End Sub
Sub AutoFitMergedCellRowHeight(Cell As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If Cell.MergeCells Then
With Cell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
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.ScreenUpdating = Ture
Application.EnableEvents = True
End Sub