Apply format to >0 cells

[BeSmart]

Hi All
I have a code below that formats cells - but it formats all cells in the row
& I need it to only format cells >0 in the row.
I tried a few things and got errors .... How do I incorporate the additional
If Then Else into this code?

Sub Decorate()
Dim rngB As Range
Dim rngTemp As Range
Set rngB = Sheets("Sheet2").UsedRange.Columns("A:S")
For R = 1 To rngB.Rows.Count
If Sheets("Sheet2").Cells(R, 1).Value = Range("A3") Then
Set rngTemp = Sheets("Sheet2").Cells(R, 1).Range("C1:S1")

'''' If rngTemp.Value <1 Then (I tried adding this - but got a "type
mismatch" error???)
''' Else

rngTemp.Font.Bold = True
With rngTemp.Interior
..ColorIndex = 41
..Pattern = xlSolid
..PatternColorIndex = xlAutomatic
End With
'''' End If
End If
Next R
End Sub

 

[OssieMac]

Firstly note that a space and underscore at the end of a line is a line break
in an otherwise single line of code.

I have had to guess a little to correct some of your code. The following
line does not say which sheet Range("A3") belongs to.

If Sheets("Sheet2").Cells(R, 1).Value = Range("A3") Then

I changed it to the following. Edit to the correct sheet if required.

If Sheets("Sheet2").Cells(R, 1).Value _
= Sheets("Sheet2").Range("A3") Then

I had difficulty working out what range you wanted in the following line.

Set rngTemp = Sheets("Sheet2").Cells(R, 1).Range("C1:S1")

I changed it to the following.

With Sheets("Sheet2")
Set rngTemp = .Range(.Cells(R, 1), .Cells(R, "S"))
End With

Revamped code as follows but I am really not sure that my assumptions above
are correct for what you want so feel free to get back to me.

Sub Decorate()
Dim rngB As Range
Dim rngTemp As Range
Dim c As Range
Dim R As Long

Set rngB = Sheets("Sheet2").UsedRange.Columns("A:S")
For R = 1 To rngB.Rows.Count
If Sheets("Sheet2").Cells(R, 1).Value _
= Sheets("Sheet2").Range("A3") Then

With Sheets("Sheet2")
Set rngTemp = .Range(.Cells(R, 1), .Cells(R, "S"))
End With

For Each c In rngTemp
If c.Value < 1 Then
c.Font.Bold = True
With c.Interior
.ColorIndex = 41
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
Next c
End If
Next R
End Sub

 

[JLatham]

Why not just use conditional formatting? Here's code that would allow you
define a range by changing a few variables in it.

See if this works for you...

Sub Decorate()
'set cells in columns C:S that have a value
' Greater Than 0 to .ColorIndex 41, solid
Const firstRowToFormat = 2
Const firstColToFormat = "C"
Const lastColToFormat = "S"
Dim lastRowToFormat As Long
Dim tmpString As String
Dim rngB As Range

tmpString = Worksheets("Sheet2").UsedRange.Address
lastRowToFormat = _
Range(Right(tmpString, Len(tmpString) - InStr(tmpString, ":"))).Row

Set rngB = Worksheets("Sheet2"). _
Range(firstColToFormat & firstRowToFormat & ":" & _
lastColToFormat & lastRowToFormat)

'for Operator, use xlLess if you need Less Than condition
With rngB
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlCellValue, _
Operator:=xlGreater, _
Formula1:="0"
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 41
.FormatConditions(1).Interior.PatternColorIndex = _
xlAutomatic
End With
Set rngB = Nothing
End Sub

 

[BeSmart]

Hi JLatham

That works great, but it formats all rows - I need it to only format rows
where the string in column A matches to the value in cell A3. If it matches
then the formatting happens to that row.

I'll then repeat the macro but for A4, A5, A6 (and applying a different
interior colour) - unless you know of how to do that automatically in the
macro??

 

[BeSmart]

Hi OssieMac

I did one quick tweak and it worked great!!!! Thank you so much!! - your
assumptions were correct & I'm sorry for not providing better information...

i.e. changed:
If c.Value < 1 Then
to
If c.Value > "0" Then


Can I ask one last question please...

Is there a way to apply the interior colour that is nominated by the user?
i.e. they apply fill to B3 - next to A3?? so we end up with a list of product
names in A3:A10 and fill colours to apply to each product name in B3:B10.

I have 7 products to apply it too (at the moment) - do I need to create 7
macros or is there a way of repeating the macro for cell A4, then cell A5,
then cell A6 etc...

I would finish with a table of data where each row is colour coded to match
the list of 7 products at the top of the page.

If you can help me with this it would be amazing.
Thanks again
BeSmart

 

[OssieMac]

Hi again,

I am still not sure that I fully understand. You say to match colors B3:B10
and then quote "list of 7 products at the top of the page". B3:B10 is 8
cells not 7.

My previous code started at the top of the page for setting the colors.
However your quote "I would finish with a table of data where each row is
colour coded to match the list of 7 products at the top of the page". I am
wondering if R should start at row 11 under the products at the top of the
page and not start from row 1.

If I understand correctly, the user will manually color the cells B3:B10 and
you want to get these colors for each of the matches in cells A3:A10. If
correct, then try the following. (I have started R at row 11)

Sub Decorate()
Dim rngB As Range
Dim rngTemp As Range
Dim c As Range
Dim R As Long
Dim colIdx As Integer
Dim j As Long

Set rngB = Sheets("Sheet2") _
.UsedRange.Columns("A:S")

For j = 3 To 10
For R = 11 To rngB.Rows.Count
If Sheets("Sheet2").Cells(R, 1).Value _
= Sheets("Sheet2").Cells(j, "A") Then

colIdx = Sheets("Sheet2") _
.Cells(j, "B").Interior.ColorIndex

With Sheets("Sheet2")
Set rngTemp = .Range(.Cells(R, 1), _
.Cells(R, "S"))
End With

For Each c In rngTemp
If c.Value > 0 Then
c.Font.Bold = True
With c.Interior
.ColorIndex = colIdx
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
Next c
End If
Next R
Next j
End Sub

'***********************************

Not sure if the following will help but have included it for info because
the ColorIndex matrix provided in Excel help is not accurate.

The code will create a sample of all of the ColorIndex colors. The row
number will be the ColorIndex. Run it on a blank worksheet and you can
actually copy the various cells and use Paste Special -> Formats to put the
colors in your range B3:B10.

Sub IntColIdx()
Dim i As Integer
'Edit "Sheet3" to match your required sheet.
With Sheets("Sheet3")
For i = 1 To 56
.Cells(i, 1).Interior.ColorIndex = i
Next i
End With
End Sub

 

[BeSmart]

Hi OssieMac

THAT is awesome!!!! Again with a few little changes it's working perfectly!!!!
Your assumptions were spot on!!!
Thank you soooo much!!!