Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I have the macro developed by Jim Rech, will adjust the height of a
merged/wrapped cell in a single row and have changed it from : Sub AutoFitMergedCellRowHeight() * code here * end sub To: 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 If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 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 End Sub This is to activate the macro automatically when the merged cells are changed and the enter key is pressed but it is not working. It is located in a module and other test code will run successfully. Office 2003. What am I missing? |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hi,
You'll need to move the Worksheet_Change sub out of the Module and put it in the worksheet code module.... -- Hope that helps. Vergel Adriano "bluegrassstateworker" wrote: I have the macro developed by Jim Rech, will adjust the height of a merged/wrapped cell in a single row and have changed it from : Sub AutoFitMergedCellRowHeight() * code here * end sub To: 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 If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 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 End Sub This is to activate the macro automatically when the merged cells are changed and the enter key is pressed but it is not working. It is located in a module and other test code will run successfully. Office 2003. What am I missing? |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
On Apr 25, 2:58 pm, Vergel Adriano
wrote: Hi, You'll need to move the Worksheet_Change sub out of the Module and put it in the worksheet code module.... -- Hope that helps. Vergel Adriano "bluegrassstateworker" wrote: I have the macro developed by Jim Rech, will adjust theheightof a merged/wrapped cell in a singlerowand have changed it from : Sub AutoFitMergedCellRowHeight() * code here * end sub To: 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 If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 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 End Sub This is to activate the macro automatically when the merged cells are changed and the enter key is pressed but it is not working. It is located in a module and other test code will run successfully. Office 2003. What am I missing?- Hide quoted text - - Show quoted text - I have put this into the Worksheet module without success. Any other ideas? |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
On Apr 26, 9:48 am, bluegrassstateworker
wrote: On Apr 25, 2:58 pm, Vergel Adriano wrote: Hi, You'll need to move the Worksheet_Change sub out of the Module and put it in the worksheet code module.... -- Hope that helps. Vergel Adriano "bluegrassstateworker" wrote: I have the macro developed by Jim Rech, will adjust theheightof a merged/wrapped cell in a singlerowand have changed it from : Sub AutoFitMergedCellRowHeight() * code here * end sub To: 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 If ActiveCell.MergeCells Then With ActiveCell.MergeArea If .Rows.Count = 1 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 End Sub This is to activate the macro automatically when the merged cells are changed and the enter key is pressed but it is not working. It is located in a module and other test code will run successfully. Office 2003. What am I missing?- Hide quoted text - - Show quoted text - I have put this into the Worksheet module without success. Any other ideas?- Hide quoted text - - Show quoted text - Thanks to Jim Rech for the solution! Something to share with everyone. The source of failure we found in my case was that upon hitting the enter key, the focus was being changed from the cell to where the cursor would go after hitting the enter key and not where it was. This was because my system was using the default setting to go to the right on pressing the enter key. If you go into TOOLS | OPTIONS | Edit tab | Move Selection After Enter, you will see your setting. The below code works around that so any setting is possible AND if there are any new worksheets created with a merged cell and text wrap, it will work on all cells. Here is what Jim did: This code was put in the "This Workbook" module Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) AutoFitMergedCellRowHeight Target End Sub Then he put the following code in a module: Sub AutoFitMergedCellRowHeight(Target As Range) Dim CurrentRowHeight As Single, MergedCellRgWidth As Single Dim CurrCell As Range Dim ActiveCellWidth As Single, PossNewRowHeight As Single Set Target = Target.Cells(1) ''In case several cells are changed at once If Target.MergeCells Then With Target.MergeArea If .Rows.Count = 1 And .WrapText = True Then Application.ScreenUpdating = False CurrentRowHeight = .RowHeight ActiveCellWidth = Target.ColumnWidth For Each CurrCell In .Cells 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 End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Set a minimum row height a the same time with autofit row height | New Users to Excel | |||
Row Height stopped growing and Auot-Fit Row Height does not work | Excel Discussion (Misc queries) | |||
the row height should be excatly the height of the data | Excel Discussion (Misc queries) | |||
Resizing row height to dynamically fit height of text box | Excel Discussion (Misc queries) | |||
Set new row height based on current height | Excel Programming |