Worksheet_Change even code will not run

retseort

New Member
Joined
Oct 31, 2005
Messages
34
Ok, this code would run if used in Worksheet Selection Change but it would only autofit the merged cells if I exited and then re-enterd the cell. I want it to autofit merged cells upon text entry or exiting the cell.

Please take a look and tell me why it does nothing.

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
ActiveCell = Target.Column
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 + MeregedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
Application.EnableEvents = True
End If
End With
End If
End Sub
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,494
Hi,

Without understanding your code, have you quit from the macro, leaving EnableEvents set to False? - try closing your w/book & re-opening.
 

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,494
Hi,

Tidied up your code, moved the application.enableevents=true, also corrected the spolling mistook ("MeregedCellRgWidth "), it now sets the first cell of the changed range to the column ( :confused: )

What were you trying to achieve?

Code:
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
ActiveCell = Target.Column

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
 

retseort

New Member
Joined
Oct 31, 2005
Messages
34

ADVERTISEMENT

I need the code to take the sheet it is assigned to and every time a user enters text in merged cells it autofits the cell or row so that all text is visible. I will take a look at your changes. Thanks
 

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,494
Hi,

If you remove the activecell=target.column, it seems to work ok:
Code:
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
'ActiveCell = Target.Column

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
 

retseort

New Member
Joined
Oct 31, 2005
Messages
34

ADVERTISEMENT

Weird, I pasted it in and it doesn't work.

Here is the code as seen in my spreadsheet. It is assigned to the sheet it should affect I am using XL2000

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
'ActiveCell = Target.Column
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
 

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,494
Weird indeed!

I actually wrote a quick sub
Sub Enable()
Application.enableevents=true
end sub

which I called if I ever exitted from the worksheet change event.

Thinking about it, why do you need the application.enableevents=False anyway - you dont actually change a cell.
 

retseort

New Member
Joined
Oct 31, 2005
Messages
34
I thought you had indicated you got it to work. I copied it into a blank spreadsheet and tried it and still nothing. I guess I am out of options.

Thanks for trying [/img][/url]
 

retseort

New Member
Joined
Oct 31, 2005
Messages
34
Alan or anyone else got any ideas on this issue?

Issue: Ok, this code would run if used in Worksheet Selection Change but it would only autofit the merged cells if I exited and then re-enterd the cell. I want it to autofit merged cells upon text entry or exiting the cell.


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
'ActiveCell = Target.Column

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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,055
Messages
5,569,948
Members
412,299
Latest member
agentless
Top