Automatically Adjust Row Height?

[Miles]

I'm looking for a way (probably a macro) to automatically adjust row height based upon the number of lines in a specified range of columns. Specifically, for a specified range of rows, I would like to adjust the row height of each row to be (the maximum number of lines of text in columns B thru E in that row) times 12.75 plus 15.


For example, if there are 3 rows of text in B6, C6, and D6, but 6 rows of text in cell E6, I would like to adjust the height of row 6 to be 91.5 (=6*12.75 + 15).


Any ideas on how to do this?

 

[Luke M]

If you want to adjust row height as you work:

Private Sub Worksheet_Change(ByVal Target As Range)

'Is it a cell we care about?

If Intersect(Target, Range("B:E")) Is Nothing Then Exit Sub


Application.EnableEvents = False


Dim xLineCount As Integer

Dim CheckCount


'Don't want a height of 0...I think

xLineCount = 1

For Each c In Range(Cells(Target.Row, "B"), Cells(Target.Row, "E"))

CheckCount = Len(c) - Len(WorksheetFunction.Substitute(c, Chr(10), "")) + 1

xLineCount = WorksheetFunction.Max(xLineCount, CheckCount)

Next c


Target.RowHeight = xLineCount * 12.75 + 15


Application.EnableEvents = True


End Sub



If you want to run the code once and have it adjust all lines that you specify:



Private Sub AdjustHeight()

Dim xLineCount As Integer

Dim CheckCount

Dim xRows As Integer

'Change this lines as desired

For xRows = 2 To 10


'Don't want a height of 0...I think

xLineCount = 1

For Each c In Range(Cells(xRows, "B"), Cells(xRows, "E"))

CheckCount = Len(c) - Len(WorksheetFunction.Substitute(c, Chr(10), "")) + 1

xLineCount = WorksheetFunction.Max(xLineCount, CheckCount)

Next c

Cells(xRows, 1).RowHeight = xLineCount * 12.75 + 15


Next xRows

End Sub

 

[Miles]

Luke,


The first one works great (thanks) but by counting line feeds (Chr(10)) it does not recognize the number of lines created by automatically wrapping text within a cell. Is there any way of determining the number of lines resulting in a cell with "wrap text"?


Thanks!

 

[Luke M]

Miles,

Not that I'm aware of...

a) that would be inversley related to how wide the column is.

b) the cell value is the same, so not sure how to detect via formula/vb


If you knew the font size and did a couple of tests, you might be able to get close by counting number of chracters in a cell, dividing by how many characters a certain column will allow...but then again, some characters take less space than others. =(


Not exactly what you asked for, but perhaps something like this would be adequate?

c.EntireRow.AutoFit

c.RowHeight = c.RowHeight + 15

That at least would make sure the row is tall enough, and add a little extra on.

 

[Miles]

Thanks Luke. I wasn't able to implement your last suggestion (yet) -- my VBA skills are very rusty -- but I greatly appreciate your help.