Find & Format Using Macro

[Kath]

Hi

Using Excel 95

I'm used to doing macros using keystrokes, but with anything mor
advanced..I'm lost.

I need to find cells containing Nos 0 - 4 and format those cells wit
colours according to the number found.


i.e.
0= background Whilte, font Black
1= background Green, font White
2= background Dark Blue, font White
3= background Pale Blue, font Black
4= background Red, font White

Can anyone help..I'm running out of time now.

I've tried to cribb some macros from various website, with n
luck..they just don't work when I run them.

Thanks in advance :

 

[Don Guillett]

try something like this.modify to suit

Sub Progresscolor()
With ActiveCell.EntireRow.Interior
Select Case [a14]
Case 1: .ColorIndex = 4
Case 2: .ColorIndex = 5
Case 3: .ColorIndex = 6
Case 4: .ColorIndex = 7
Case Else: .ColorIndex = xlNone
End Select
End With
End Sub

 

[Kath]

This must be the busiest forum I've been on.

Can no-one help me, or at least move me to the correct forum if I'm i
the wrong place

Or even point me in the right direction to get help with this ;

 

[Tom Ogilvy]

I thought Don provided some assistance.

This does 0 to 2 you should be able to get the rest. Look in help for the
colorindex property to get the colorindexes you need. This is bascially
the help example for the find method adapted to you values and requirements:

With Worksheets(2).UsedRange
Set c = .Find(0, lookin:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 2 'white
c.Font.ColorIndex = 1 ' black
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

With Worksheets(2).UsedRange
Set c = .Find(0, lookin:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 4 'green
c.Font.ColorIndex = 2 ' White
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End Wit


With Worksheets(1).UsedRange
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 32 'darker is 25
c.Font.ColorIndex = 2 ' white
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

 

[Tom Ogilvy]

this is tested and all refer to the same sheet <g>

Sub AAAA()
With Worksheets(1).UsedRange
Set c = .Find(0, LookIn:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 2 'white
c.Font.ColorIndex = 1 ' black
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

With Worksheets(1).UsedRange
Set c = .Find(0, LookIn:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 4 'green
c.Font.ColorIndex = 2 ' White
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With


With Worksheets(1).UsedRange
Set c = .Find(2, LookIn:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 32 'darker is 25
c.Font.ColorIndex = 2 ' white
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

End Sub


--
Regards,
Tom Ogilvy

I thought Don provided some assistance.

This does 0 to 2 you should be able to get the rest. Look in help for the
colorindex property to get the colorindexes you need. This is bascially
the help example for the find method adapted to you values and requirements:

With Worksheets(2).UsedRange
Set c = .Find(0, lookin:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 2 'white
c.Font.ColorIndex = 1 ' black
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

With Worksheets(2).UsedRange
Set c = .Find(0, lookin:=xlValues, Lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 4 'green
c.Font.ColorIndex = 2 ' White
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End Wit


With Worksheets(1).UsedRange
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 32 'darker is 25
c.Font.ColorIndex = 2 ' white
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With