Minimum row height
 

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

Minimum row height
 

'/========================================/
' 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
'/========================================/

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"SteveZmyname" wrote:

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

Minimum row height
 

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" wrote:

'/========================================/
' 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
'/========================================/

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"SteveZmyname" wrote:

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

Minimum row height
 

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



"SteveZmyname" wrote:

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" wrote:

'/========================================/
' 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
'/========================================/

--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown



"SteveZmyname" wrote:

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

Minimum row height
 

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

On Mon, 15 Mar 2010 12:15:02 -0700, Gary Brown
wrote:

Yes, put it in a module.
Then while the workbook containing the function is open, you can run the
macro.

Minimum row height
 

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


"Gord Dibben" wrote:

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

On Mon, 15 Mar 2010 12:15:02 -0700, Gary Brown
wrote:

Yes, put it in a module.
Then while the workbook containing the function is open, you can run the
macro.

.

Minimum row height
 

Thanks for the feedback.

Save the code for future use.

May come in handy sometime.


Gord

On Mon, 15 Mar 2010 14:40:01 -0700, SteveZmyname
wrote:

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


"Gord Dibben" wrote:

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

On Mon, 15 Mar 2010 12:15:02 -0700, Gary Brown
wrote:

Yes, put it in a module.
Then while the workbook containing the function is open, you can run the
macro.

.

Minimum row height
 

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" wrote:

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

On Mon, 15 Mar 2010 12:15:02 -0700, Gary Brown
wrote:

Yes, put it in a module.
Then while the workbook containing the function is open, you can run the
macro.

.

Minimum row height
 

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

On Tue, 16 Mar 2010 13:57:01 -0700, SteveZmyname
wrote:

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" wrote:

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

On Mon, 15 Mar 2010 12:15:02 -0700, Gary Brown
wrote:

Yes, put it in a module.
Then while the workbook containing the function is open, you can run the
macro.

.