I found this code online and applied it to my worksheet and it works as long as I hit run. Is there a way to make it run automatically? I'm creating a form for other people to use and they won't know how to hit run. I'm not experienced in coding so I don't know how to adjust it.
Sub AutoFitMergedCellRowHeight()
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 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.ScreenUpdating = True
End Sub
I applied it and it works but it does not run automatically.
I found this code online and applied it to my worksheet and it works as long as I hit run. Is there a way to make it run automatically? I'm creating a form for other people to use and they won't know how to hit run. I'm not experienced in coding so I don't know how to adjust it.
Sub AutoFitMergedCellRowHeight()
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 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.ScreenUpdating = True
End Sub
I applied it and it works but it does not run automatically.
Share Improve this question edited Feb 17 at 23:08 braX 11.8k5 gold badges22 silver badges37 bronze badges asked Feb 17 at 23:07 GinnyGinny 12 bronze badges New contributor Ginny is a new contributor to this site. Take care in asking for clarification, commenting, and answering. Check out our Code of Conduct. 01 Answer
Reset to default 0You need to put this code directly in the Worksheet its supposed to be runnin g in:
and you have to change the first line from "Sub AutoFitMergedCellRowHeight()
" to "Private Sub Worksheet_SelectionChange(ByVal Target As Range)
" so your code will be triggered when the user moves between cells.