Format cell if contains a value

[sjbeeny]

Hi, all

How would I (at the click of an activeX button) format cells wit
borders and make the cells fill colour white if it has a value in it?

Cheers,
Simon

B.T.W
Thanks for all your help for a newbi

 

[Tom Ogilvy]

Assume by value you mean the cell is not blank or does not appear blank.

for each cell in ActiveSheet.Cells.SpecialCells(xlformulas)
if cell<> "" then
cell.BordersAround ColorIndex:=1, Weight:=xlThick
cell.Interior.ColorIndex = 2
end if
Next
for each cell in ActiveSheet.Cells.SpecialCells(xlConstants)
if cell<> "" then
cell.BordersAround ColorIndex:=1, Weight:=xlThick
cell.Interior.ColorIndex = 2
end if
Next

 

[Chip Pearson]

Try something like the following:

Private Sub CommandButton1_Click()
Dim Rng As Range
For Each Rng In Range("A1:C10") '<<< CHANGE
If Rng.Value <> "" Then
Rng.BorderAround xlSolid, xlMedium
Rng.Interior.Color = RGB(255, 255, 255)
End If
Next Rng
End Sub



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[Tom Ogilvy]

my typo,
BordersAround should be BorderAround (singular)

for weight you can do xlMedium or xlThin as well

Also, specialcells will raise an error if it doesn't find cells to satisfy
the condition, so you can suppress that with

Sub ApplyBorders()
On Error Resume Next
For Each cell In ActiveSheet.Cells.SpecialCells(xlFormulas)
If cell <> "" Then
cell.BorderAround ColorIndex:=1, Weight:=xlMedium
cell.Interior.ColorIndex = 2
End If
Next
For Each cell In ActiveSheet.Cells.SpecialCells(xlConstants)
If cell <> "" Then
cell.BorderAround ColorIndex:=1, Weight:=xlMedium
cell.Interior.ColorIndex = 2
End If
Next
On Error GoTo 0
End Sub

--
Regards,
Tom Ogilvy

Assume by value you mean the cell is not blank or does not appear blank.

for each cell in ActiveSheet.Cells.SpecialCells(xlformulas)
if cell<> "" then
cell.BordersAround ColorIndex:=1, Weight:=xlThick
cell.Interior.ColorIndex = 2
end if
Next
for each cell in ActiveSheet.Cells.SpecialCells(xlConstants)
if cell<> "" then
cell.BordersAround ColorIndex:=1, Weight:=xlThick
cell.Interior.ColorIndex = 2
end if
Next

 

[billyb]

A few variations, especially if you like one-liners:

Sub HighlightAllNumbers()
On Error Resume Next
ActiveSheet.Cells.SpecialCells(xlCellTypeConstants
xlNumbers).Interior.ColorIndex = 6
End Sub

Sub HighlightAllText()
On Error Resume Next
ActiveSheet.Cells.SpecialCells(xlCellTypeConstants
xlTextValues).Interior.ColorIndex = 7
End Sub

Sub UndoAllHighlights()
On Error Resume Next
ActiveSheet.Cells.SpecialCells(xlCellTypeConstants).Interior.ColorInde
= 0
End Sub

Sub ShowColorPalette()
For x = 1 To 56
With ActiveCell 'starts at current cell
.Offset(0, 0) = x
.Offset(0, 1).Interior.ColorIndex = x
.Offset(1, 0).Select
End With
Next
End Sub

Regards,
billy

 

[sjbeeny]

Wow, Thanks for all the responses guys

Tom, I was wondering if I could limit your formulae to a specific rang
in some manner. I should have been more clear when I first asked th
question but I only want to reformat the new cells entered in range
"TitleInvoice","PriceInvoice" and "TotalInvoice" I used your formula
and it worked a little too well and changed the format of all cell
(Headings etc.)

Chip, I tried using your procedure except I changed the range to th
above ("TitleInvoice","PriceInvoice" and "TotalInvoice") but for som
reason I got an error debug msg I will look further into it.

Billyb thanks for the suggestions I am yet to have a play around wit
them but will do tonight.

Thanks for all the imput everyone!

Regards,
Simo

 

[Tom Ogilvy]

You can replace
ActiveSheet.Cells.

with any valid multiple cell reference and it will work only within that
reference.

BillyB's suggestion is really just an extension of the specialcells method I
suggested. So you should get similar results if you use Activesheet.Cells
except that he only uses the constants part of my suggestion.

 

[sjbeeny]

I tried doing as you said with a test range and it didn't work, There
was no error or anything just nothing happened. Have I entered the
range incorrectly? I used the code:

Private Sub CommandButton1_Click()

On Error Resume Next
For Each cell In Range("test").SpecialCells(xlFormulas)
If cell <> "" Then
cell.BorderAround ColorIndex:=1, Weight:=xlMedium
cell.Interior.ColorIndex = 2
End If
Next
For Each cell In Range("test").SpecialCells(xlConstants)
If cell <> "" Then
cell.BorderAround ColorIndex:=1, Weight:=xlMedium
cell.Interior.ColorIndex = 2
End If
Next
On Error GoTo 0
End Sub

Cheers, Simon

 

[sjbeeny]

Thanks for the help people all works well now.


Cheers,
Simo