Worksheet_Change even code will not run

[retseort]

I ahve the following code assigned to a worksheet. It simply will not
work and I cannot figure out why.

What it does:

This code expands merged cells where the text wraps. I go it to work
with a different event but it will not work with this set up. I would
like it to run when a user exits any cell.


Any ideas are appreciated.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Application.EnableEvents = False
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
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.EnableEvents = True
End Sub


Thanks
Dan

 

[Rowan Drummond]

When the change event fires the activecell is the cell that is selected
after the change. Target is the cell that has been changed. So if I type
"This is the text" in cell A1 and hit enter the change event will fire.
However the activecell will be A2, so you probably need to change all
Activecell references to Target.

Also you have not properly qualified all the statements in your With ...
End With block eg MergeCells = False should read .MergeCells = False and
EntireRow.AutoFit should read .EntireRow.Autofit etc.

Hope this helps
Rowan

 

[retseort]

Thanks

I made the changes you suggested. Thanks for the Target versus Activ
Cell although I find it odd that it worked under another event. But yo
know this far better than I.

However, I still cannot get this to work right any other ideas or am
still missing the boat.

My new code...

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

 

[Rowan Drummond]

If the other event you are referring to was a SelectionChange event then
in some cases you could use target and activecell interchangebly but
this is not recommended.

You haven't said exactly what it is that is not working with your new
code and I still don't follow exactly what it is you want to have it do
but for starters you have not properly qualified all the references in
you With...End With block. If you put the statement Option Explicit
right at the top of you module and try to run the event (change a cell
on the sheet) you will be promted to declare the variable MergeCells.
Because you have not qualified it it is being treated as a variable and
hence having no effect.

I have reworked this a bit so that it runs but it doesn't seem to make
any real change to the format of the sheet. You may also want to see
this reference to a post by Jim Rech on autofit with mergecells
http://tinyurl.com/aknxy (thanks Norman).

Reworked code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim TargetWidth As Single, PossNewRowHeight As Single

On Error GoTo Exit_Event
Application.EnableEvents = False
If Target.MergeCells Then
With Target.MergeArea
.Select
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
TargetWidth = Target.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth _
+ MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = TargetWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
Exit_Event:
Application.EnableEvents = True
End Sub

Regards
Rowan