Find & Format Using Macro

  • Thread starter Thread starter Kath
  • Start date Start date
K

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 :
 
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
 
This must be the busiest forum I've been on. :D

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 ;
 
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
 
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

Tom Ogilvy said:
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
Click to expand...
 
Back
Top