Change row height if cell is blank

G

Guest

Hi. I hope some-one can help.

I have hacked together and modified some code posted for other purposes by
dmcritchie (1 posting) and Tom Ogilvy (2 postings). I thought that I
understood what the code was doing, but it doesn’t seem to work – any error
is mine, not theirs.

In a column of labels with blank rows between elements I want to set the row
height to 6 if the cell is blank, otherwise leave the row height as default.

The code is given below:

'Macro to set row heights
Sub SetHeights()
AutoCalcOff
Dim cell As Range, Rng As Range
Set Rng = Range("B2:B" & Cells.Rows.Count). _
SpecialCells(xlConstants, xlTextValues)
For Each cell In Rng
If Len(Trim(cell.Value)) = 0 Then
cell.EntireRow.RowHeight = 6
End If
Next cell
AutoCalcOn
End Sub

AutoCalcOff and AutocalcOn are calls to other subroutines.

Regards

Phil Smith
 
G

Guest

tom is the expert, so I don't often get to modify his code. I think this is
a better way of doing what you have below. the logic you have to determine
if all the cells in a row are empty is faulty.

the code will work with your range also.

Sub blankline()

'get last cell in column with data
'columns.count is a constant which is the last column number
'xltoleft moves from the last column to left until a CELL IS FOUND
Lastcolumn = Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Column
'A empty row will have lastt column as 1
'Need to make surre column 1 is also empty
If (Lastcolumn = 1) And IsEmpty(Cells(ActiveCell.Row, 1)) Then

ActiveCell.EntireRow.RowHeight = 6

End If


End Sub
 
K

kemal

Do you mean something below or ?


Dim rng As Range, i As Range

Application.EnableEvents = False
Application.ScreenUpdating = False

With Worksheets("yoursheet")
Set rng = .Range("b2", .Range("b" & Rows.Count).End(xlUp))
End With

For Each i In rng
If Len(i.Value) = 0 Then
i.EntireRow.RowHeight = 6
End If
Next i

Application.EnableEvents = True
Application.ScreenUpdating = True
 
G

Guest

Hi Joel.

Thanks for this. Your generic solution was better than my hacked together
version. Please note any errors were mine not Tom's.

Regards
Phil
 
G

Guest

Set Rng = Range("B2:B" & Cells.Rows.Count). _
SpecialCells(xlConstants, xlTextValues)

selects cells that contain hard coded entries that are text, i.e. usually
something typed in by the User that wouldn't be considered a formula.

You next loop through that range of cells containing text values looking for
an empty cell. The only cells that would meet you test would be cells that
contain only spaces or characters which would be removed by TRIM (as far as I
know, only spaces).

So your logic says look at all the non empty cells containing hard coded
values and find an empty cell.

this might be why it isn't behaving as you intended.


Sub SetHeights()
AutoCalcOff
Dim cell As Range, Rng As Range
Set Rng = Range("B2:B" & Cells.Rows.Count). _
SpecialCells(xlblanks)
For Each cell In Rng
If Len(Trim(cell.Value)) = 0 Then
cell.EntireRow.RowHeight = 6
End If
Next cell
AutoCalcOn
End Sub

would be more along the lines of what I would expect for this mission.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top