PDA

View Full Version : Solved: Selective Event



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

XLGibbs
01-23-2006, 11:11 AM
So you only want the AutoFit macro to be called when an actual value is changed?

Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty(Target) Or Target Is Nothing Then
Exit Sub
Else
Call AutoFitMergedCellRowHeight(Target)
End If
End Sub


Lightly tested. Macro did not fire on formatting changes or after deleting a cells contents...

cleturno
01-23-2006, 12:04 PM
When I delete something I am getting an error

Cell.MergeArea = <Application-defined or object-defined error>

I don't know why because it works with an on Error Resume Next, but then it becomes elective and only works on part of the table I don't know.
If Cell.MergeCells Then
With Cell.MergeArea

'Error is on the line above.

XLGibbs
01-23-2006, 12:33 PM
If understand your intent, which is unmerge, and auto fit merged cells...but not change the format if the value is deleted, or other conditions different than value changing...this seems to work for me with some minor adjustments to the conditional testing... see if this gets you closer...


Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsEmpty(Target) And Target.MergeCells = True Then
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
With Cell
If .Text <> "" Then
If .MergeArea.Rows.Count = 1 And .MergeArea.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 If
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

cleturno
01-23-2006, 12:42 PM
What I am trying to do is take merged cells with wordwrap enabled to fit the text that is put into them. So what I am doing is unmerging adjusting height and then remerging the cells back together. I think that I can make that work though give me a few to test and I will repost. Thanks

XLGibbs
01-23-2006, 12:48 PM
Okay, my main concern was that you wanted to only run it with merged cells, and not when contents were deleted or other changes made.....it did fire for me using format cells etc....only if the contents changed....if it was empty or the text was nothing then it skipped the routine...

cleturno
01-23-2006, 12:51 PM
Your routine seems to be working fine, but it is not merging the cells back together working on that now though and hoping that it won't crater. The other problem is that when someone deletes or inserts rows. I need to do a module to format those inserted cells to though.

cleturno
01-23-2006, 03:04 PM
Thanks for your help everyone, but I found a solution to the problem after someone pointed out that the problem had already been solved and to look at that. I figured out where I was going wrong. Thanks once again. Everyone have a great evening