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
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

al_b_cnu

Well-known Member
Joined
Jul 18, 2003
Messages
4,526
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,526
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,526
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,526
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,133
Messages
5,835,588
Members
430,368
Latest member
User800

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top