Minimum row height

[SteveZmyname]

Hello
I'm using the auto fit row height and it works very well but what if I want
to set a minimum row height such as 105 and have it expand only if it is
greater than that?

thanks

 

[Gary Brown]

'/========================================/
' Sub Purpose: make all rows iHeight or greater
'/========================================/
'
Public Sub ChangeHeight()
Dim dbl As Double
Dim dblLastRow As Double
Dim iHeight As Integer
Dim strSelection As String

On Error GoTo err_Sub

'variable height
iHeight = 105

'save original selection
strSelection = Selection.Address

'autofit all rows
Cells.EntireRow.AutoFit

'get last row in worksheet
dblLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row

'loop through all rows, if height < desired, make desired height
For dbl = 1 To dblLastRow
If Range("A1").Offset(dbl - 1, 0).RowHeight < iHeight Then
Range("A1").Offset(dbl - 1, 0).RowHeight = iHeight
End If
Next dbl

exit_Sub:
On Error Resume Next
Exit Sub

err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: " & _
"ChangeHeight - " & Now()
GoTo exit_Sub

End Sub
'/========================================/

 

[SteveZmyname]

Thanks Gary
This code looks excellent. Do I put this in a code module?
How do I activate or call the ChangeHeight procedure?
Sorry for the newbie questions.

 

[Gary Brown]

Yes, put it in a module.
Then while the workbook containing the function is open, you can run the
macro.
--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown

 

[Gord Dibben]

You may want to have the code an event type so's it will run as you enter.

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10"
Dim cell As Range
Dim iHeight As Long
iHeight = 105

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
For Each cell In Target
With cell
.WrapText = True
If .RowHeight < iHeight Then
.RowHeight = iHeight
End If
End With
Next cell
End If

ws_exit:
Application.EnableEvents = True
End Sub

Right-click on the sheet tab and "View Code"

Copy/paste the code to that sheet module.

Edit WS_RANGE to suit. Alt + q to return to Excel.


Gord Dibben MS Excel MVP

 

[SteveZmyname]

thanks for the suggestion but I like it with the flexability to run it when I
need it.

 

[Gord Dibben]

Thanks for the feedback.

Save the code for future use.

May come in handy sometime.


Gord

 

[SteveZmyname]

Hello
How do I go about changing this to run from the macro menu?
The other macros are public so I changed this to public as well, put it in
the module code but it doesn't show up with the other macros?
thanks for your help

 

[Gord Dibben]

This is event code and is not run as a macro.

Event codes and macros that take arguments do not show up in Macro Menu

It runs when a change event takes place.

i.e. when you type in a cell then hit ENTER key.

If you want a macro to run at your command, I believe you were given one by
Gary Brown earlier in this thread.


Gord