change font of certain cells in row(s) when ColorIndex of Column S changes

[KAS]

I am an intermediate user of Excel and VBA. I have a problem where
exported worksheets are transferred and then printed out. The rows are
color coded as to what to do if a row is a certain color. However we
don't use/have a color printer, it does give different shades of
grey, but is not all that discernable on a printout.

I took an original DAVID MCRITCHIE routine and modified it. (Thank you
very much Mr. McRitchie J)

Sub ChangeFontPerColorindexOfColS()
'Commented out UPPER CASE sections are from Original which precedes
areas I needed to subsitute.
'Modified David McRitchie Sub Originally {Sub DeleteRowsRedIncolA() }
'DAVID MCRITCHIE 2002-01-17
' HTTP://WWW.MVPS.ORG/DMCRITCHIE/EXCEL/COLORS.HTM
'WILL NOT FIND COLOR DUE TO CONDITIONAL FORMATTING
'Again, Thank you very much Mr. McRitchie J
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
Dim rng As Range, ix As Long
' SET RNG = INTERSECT(RANGE("A:A"), ACTIVESHEET.USEDRANGE)
Set rng = Intersect(Range("S:S"), ActiveSheet.UsedRange)
For ix = rng.Count To 1 Step -1
If rng.Item(ix).Interior.ColorIndex = 3 Then
rng.Item(ix).Font.Bold = True
' rng.Item(ix).EntireRow.Delete
With rng.Item(ix).Font
.Name = "Arial"
.Size = 12
End With
End If
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


The above modified David McRitchie Sub originally {Sub Delete
RowsRedInColA() } will change the font and size of all rows at the
intersect(Column S).
My question is, how can I modify this to change font of certain cells
in the row(s) when ColorIndex of Column S changes.
IE:
If the colorindex of S is 3 (red), I want to change the font to bold
and size to 12, for columns A thru R,in that row.
If the colorindex of S is 7(purple) I want to change the font to bold
and size 12, for columns A & B in that row.
If the colorindex of S is 8(ltblue) I want to change the font to bold
for column A in that row.

I have tried so many different combinations (offsets, ranges, etc),
there are too many to list here. I am embarrassed to say also I have
been working on this for months. I tried changing it to select cells
per the color index, and it appears to stall after changing/selecting
only the first row. It seems I am not declaring something or I need an
array (which I don't understand all that well), or.... . I dunno. I
am using this as a tool to learn stepping thru data and IF statements.
I also tried Select Case scenarios to no avail. If I can get a clear
cut reason as to why the routine stops after the first iteration, it
may give me some good insight as to logical syntax in IF and Select
Case statements. I hope Mr. McRitchie is ok with me using his stuff.

Problems are just opportunities for achievements, to someone.

 

[Peter T]

Not sure if I've followed but have a go with this:

Sub test()
Dim rng As Range, cell As Range
Dim nCol As Long
On Error GoTo errH
Set rng = Intersect(Range("S:S"), ActiveSheet.UsedRange)
If rng Is Nothing Then
MsgBox "Column S is not in the Used Range"
Exit Sub
End If
'Application.ScreenUpdating = False 'if very large range
For Each cell In rng
nCol = 0

Select Case cell.Interior.ColorIndex
Case 3: nCol = 18 'do col's A:R
Case 7: nCol = 2 'do A:B
Case 8: nCol = 1 'do A
End Select

If nCol Then
With Range((Cells(cell.Row, 1)), Cells(cell.Row, nCol)).Font
.Bold = True
.Size = 12
End With
End If
Next
errH:
'Application.ScreenUpdating = True
End Sub

when ColorIndex of Column S changes

If you meant "font.colorindex" change "cell.Interior.ColorIndex" in the code
to font.

If your cells in Col S are coloured due to conditional formats, you would
need to replicate and check the condition of your formula.

Although it's a good idea to disabled calculation when deleting rows, it's
not necessary for changing formats.

Regards,
Peter T

 

[KAS]

Thank you very much Peter T for such a quick response, works great. I
think I understand why it works; yet it is nowhere near what I thought
the result (code) would be. Or for that matter anywhere near any of the
many bits of code I tried to use. As I mentioned I am trying to use
this as learning tool. I am going to try to analyze and dissect the
code later and post back what I don't understand. But I did want to
reply to Peter T's expedient response ASAP. Again, Thank you very much
Peter T.

 

[KAS]

Thank you very much Peter T for such a quick response, works great. I
think I understand why it works; yet it is nowhere near what I thought
the result (code) would be. Or for that matter anywhere near any of the
many bits of code I tried to use. As I mentioned I am trying to use
this as learning tool. I am going to try to analyze and dissect the
code later and post back what I don't understand. But I did want to
reply to Peter T's expedient response ASAP. Again, Thank you very much
Peter T.

 

[Peter T]

Glad it works. I'm sure you will be able to work it out, and when you do
realise how easy it is to adapt. And you would need to if the first column
of format changes is not always column A.

For the sake of completeness, in the example I posted you should "handle"
any error, otherwise you won't know if it failed, eg

errH:
If err.number <> 0 then
Msgbox "An error occurred" ' eg protected cells perhaps
End If

Regards,
Peter T