Apply bottom border only on filled cells, leaves blank cells without border?

[StargateFan]

I need to apply a bottom border to only filled cells. Archives didn't
yield anything pertinent that I could find but I was able to figure
which line style by recording the keystrokes. I need the hairline
style on the bottom edge, if this is any help:

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone

Thanks so much. D

 

[Helmut Weber]

Hi StargateFan,

try this:
Sub Test4000()
Dim oCll As Range
For Each oCll In ActiveSheet.UsedRange
If oCll.Value <> "" Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlMedium
oCll.Borders(xlEdgeBottom).ColorIndex = 3
End If
Next
End Sub


--
Greetings from Bavaria, Germany

Helmut Weber
Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[StargateFan]

I need to apply a bottom border to only filled cells. Archives didn't
yield anything pertinent that I could find but I was able to figure
which line style by recording the keystrokes. I need the hairline
style on the bottom edge, if this is any help:

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone

Thanks so much. D

Hi StargateFan,

try this:
Sub Test4000()
Dim oCll As Range
For Each oCll In ActiveSheet.UsedRange
If oCll.Value <> "" Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlMedium
oCll.Borders(xlEdgeBottom).ColorIndex = 3
End If
Next
End Sub

Greetings, Bavaria! <g>

This is cool. It almost works. I realized that a colour should be
defined as well as adding the above hairline code in for the weight so
it now reads like this:

Sub zPutBottomBorderOnSelectedCellsThatHaveTEXT()
Dim oCll As Range
For Each oCll In ActiveSheet.UsedRange
If oCll.Value <> "" Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlHairline
oCll.Borders(xlEdgeBottom).ColorIndex = 1
End If
Next
End Sub

However, a couple of things hopefully can be finetuned. Instead of
putting a border just on the cells that have text in the selected
area, it puts a border on everything on the rows of the selected cells
which defeats the purpose <g>.

Also, there are very small columns separating the larger columns that
can contain text. This is in an effort to have a gap between the
individual letters so that wherever a letter should go, it's
represented by this empty long dash for each done by the bottom
border. Once the borders are put in, I will just delete the letters
themselves. This is so that the user knows how many letters are
supposed to be in the answer. Since the above seems to be putting a
border under even these separator cells with no text, the result is
one long line instead of "dashes".

Can this be fixed so that the macro _only_ underlines non-empty cells
in a selection of cells rather than all the rows in the selection?

Thanks. It's a great beginning. D

 

[Debra Dalgleish]

You could also use conditional formatting to apply the border:
Select the cells, and choose Format>Conditional Formatting
From the first dropdown, choose Formula Is
In the formula box, type a formula that refers to the active cell (you
can see its address in the Name box, to the left of the Formula Bar):
=A1<>""
Click Format, and on the Borders tab select a colour for the border, and
click the bottom border in the diagram.

 

[Helmut Weber]

Hi StargateFan,

are you speaking of text as opposed to digits
and just characters other than a-z and A-Z?

Instead of putting a border just on the cells
that have text in the selected
area, it puts a border on everything
on the rows of the selected cells
which defeats the purpose <g>.

Hmm...

See also: http://tinyurl.com/2jbleh
for empty vs null vs ""

Sub Test4000B()
Dim oCll As Range
For Each oCll In ActiveSheet.UsedRange
If Not LCase(oCll.Value) = UCase(oCll.Value) Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlHairline
oCll.Borders(xlEdgeBottom).ColorIndex = 1
Else
' otherwise remove border, skip this one if you like
oCll.Borders(xlEdgeBottom).LineStyle = xlNone
End If
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[StargateFan]

Hi StargateFan,

are you speaking of text as opposed to digits
and just characters other than a-z and A-Z?

Dang, I see that I might not have made that clear at all. I'm sorry.
When one is describing things, often things get left out.

I mentioned here about the selected area but I didn't in my original
msg. So sorry.

Hmm...

See also: http://tinyurl.com/2jbleh
for empty vs null vs ""

Sub Test4000B()
Dim oCll As Range
For Each oCll In ActiveSheet.UsedRange
If Not LCase(oCll.Value) = UCase(oCll.Value) Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlHairline
oCll.Borders(xlEdgeBottom).ColorIndex = 1
Else
' otherwise remove border, skip this one if you like
oCll.Borders(xlEdgeBottom).LineStyle = xlNone
End If
Next
End Sub

This was a little better as it missed out on column A. Again, it's
the missing selected area problem.

I added this to the code, btw.
Range("E1:AH34").Select
If I rephrase my question, perhaps I'll get it right this time <g>.
Just need a macro to underline the filled cells in the selected area
and leave all the blank ones alone. But it might be best not to
narrow it down to these cells specifically and to just tell it to
follow the selection, just in case I need to make this sheet wider.

****************************
Again, sorry about that. I've been working 3 solid days now on this
long weekend so that I can get ahead on all my projects that have
pretty much taken a back seat to the work ones. Last couple of weeks
have been filled with overtime trying to get fiscal year end stuff
done. And next week is my final week at my present job contract and
I'll be training a new person. So I'm not as sharp as I'd like to be
what will all that's going on <g>.

Thanks in advance for your forbearance. Cheers. D

 

[Helmut Weber]

Hi StargateFan,

i'm running out of names for macros. ;-)

Sub Test4000BX()
Dim oCll As Range
For Each oCll In Selection.Cells ' !
If oCll.Value <> "" Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlMedium
oCll.Borders(xlEdgeBottom).ColorIndex = 3
Else
' otherwise remove border or skip it if you like
oCll.Borders(xlEdgeBottom).LineStyle = xlNone
End If
Next
End Sub

************************
Again, sorry about that.

No problem at all.
Have mercy with me in exchange
should my thoughts lead me astray occasionally.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[StargateFan]

Hi StargateFan,

i'm running out of names for macros. ;-)

Sub Test4000BX()
Dim oCll As Range
For Each oCll In Selection.Cells ' !
If oCll.Value <> "" Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlMedium
oCll.Borders(xlEdgeBottom).ColorIndex = 3
Else
' otherwise remove border or skip it if you like
oCll.Borders(xlEdgeBottom).LineStyle = xlNone
End If
Next
End Sub


No problem at all.
Have mercy with me in exchange
should my thoughts lead me astray occasionally.

<g> You're very kind.

Thanks! This works great. I had a bit of trouble till I remembered
that my sheet was protected. Too many things to remember at once,
sometimes <g>. Once I fixed that, it did the trick. Much
appreciated. D

 

[StargateFan]

<g> You're very kind.

Thanks! This works great. I had a bit of trouble till I remembered
that my sheet was protected. Too many things to remember at once,
sometimes <g>. Once I fixed that, it did the trick. Much
appreciated. D

************************************************************************************************
Sub UnderlinePUZZLEboxes()

Range("E6:AI35").Select

Dim oCll As Range
For Each oCll In Selection.Cells ' !
If oCll.Value <> "" Then
oCll.Borders(xlEdgeBottom).LineStyle = xlContinuous
oCll.Borders(xlEdgeBottom).Weight = xlHairline
oCll.Borders(xlEdgeBottom).ColorIndex = 1
Else
' otherwise remove border or skip it if you like
oCll.Borders(xlEdgeBottom).LineStyle = xlNone
oCll.Borders(xlEdgeBottom).ColorIndex = 2
End If
Next

With ActiveSheet
.EnableAutoFilter = True
.Protect UserInterfaceOnly:=True
End With


End Sub
************************************************************************************************

There's always something, eh?

I came back to this spreadsheet but found one difficulty. At the end,
I need to copy this puzzle to the clipboard. But after changing the
borders to white so that the entire spreadsheet would copy to a
graphic without the "invisible" grid lines, found that the above macro
puts those gridlines back. I tried to compensate for it but making
the colour index 2 for the colour white in the "Else" part, but I'm
obviously doing something wrong as the gridlines still remain.

If the macro above would apply the HAIRLINE, BLACK border to only the
cells that had text in them in the selection, yet left the balance in
the selection white all around, that would be idea.

Thanks for any help re this. D