Help please with coding a macro

[Guest]

Need help creating a macro to apply this set of 5 conditional format criteria
to a data range in my report? Font is Arial regular, 11 point.

IF current cell value is not equal to ="N/A", THEN current cell font is black.
IF current cell value is </= 4.004, THEN fill current cell color bright
green, font is black.
IF current cell value is between 4.005 AND 4.099, THEN fill current cell
color yellow, font is black.
IF value in cell one column Left same row is >/= 4.005, AND current cell
value is >/= 4.005, THEN fill current cell color red, font is bold white.
IF current cell value is >/= 5.0, THEN fill current cell color red, font is
bold white.

Using MS Office Excel 2003, MS Windows XP Pro 2002.

Thanks!

 

[Bob Phillips]

Adjust the rng Constant to suit

Option Explicit

'--------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'--------------------------------------------------------------
Const rng As String = "H1:H10"

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(rng)) Is Nothing Then
With Target
.Font.ColorIndex = xlColorIndexAutomatic
.Interior.ColorIndex = xlColorIndexNone
Select Case True
Case .Value = "N/A":
Case .Value < 4.004:
.Interior.ColorIndex = 4
Case .Offset(0, -1).Value > 4.005:
.Font.ColorIndex = 2
.Font.Bold = True
.Interior.ColorIndex = 3
Case .Value < 4.099:
.Interior.ColorIndex = 6
Case Else:
.Font.ColorIndex = 2
.Font.Bold = True
.Interior.ColorIndex = 3
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Guest]

Hi Bob, thanks!

However, instead of a Change procedure, could you please make this macro
update the formatting as a result of sheet re-calculation?

Reason is that I'm "mirroring" this data into my Report worksheet from a
subset on a different worksheet in the same workbook, so I'm not actually
typing into this report. Here's the formula:
=IF(HLOOKUP(F$27,'Manual Input'!$108:$156,6,FALSE)<>0,HLOOKUP(F$27,'Manual
Input'!$108:$156,6,FALSE),NA())

 

[Bob Phillips]

Does this do what you want?

Private Sub Worksheet_Calculate()
Const rng As String = "H1:H10"
Dim cell As Range

On Error GoTo ws_exit:
Application.EnableEvents = False
For Each cell In Range(rng)
With cell
.Font.ColorIndex = xlColorIndexAutomatic
.Interior.ColorIndex = xlColorIndexNone
Select Case True
Case .Value = "N/A":
Case .Value < 4.004:
.Interior.ColorIndex = 4
Case .Offset(0, -1).Value > 4.005:
.Font.ColorIndex = 2
.Font.Bold = True
.Interior.ColorIndex = 3
Case .Value < 4.099:
.Interior.ColorIndex = 6
Case Else:
.Font.ColorIndex = 2
.Font.Bold = True
.Interior.ColorIndex = 3
End Select
End With
Next

ws_exit:
Application.EnableEvents = True
End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)