Sub ColorCells1()
Dim rgSales As Range
Dim i As Long, j As Long
Dim lngUpperCut As Long
Dim lngLowerCut As Long
Dim res As Variant, res1 As Variant
res = InputBox("Enter Upper cutoff value")
If res = "" Then Exit Sub
If Not IsNumeric(res) Then Exit Sub
res1 = InputBox("Enter LowerValue")
If res1 = "" Then Exit Sub
If Not IsNumeric(res1) Then Exit Sub
lngUpperCut = CLng(res)
lngLowerCut = CLng(res1)
Set rgSales = Selection
rgSales.Font.ColorIndex = xlAutomatic
For i = 1 To rgSales.Rows.Count
For j = 1 To rgSales.Columns.Count
If rgSales.Cells(i, j).Value < lngUpperCut Then
If rgSales.Cells(i, j).Value < lngLowerCut Then
rgSales.Cells(i, j).Font.ColorIndex = 5
Else
rgSales.Cells(i, j).Font.ColorIndex = xlAutomatic
End If
Else
rgSales.Cells(i, j).Font.ColorIndex = 3
End If
Next j
Next i
End Sub

--
Regards,
Tom Ogilvy


"Tom Ogilvy" wrote in message
...
Sub ColorCells()
Dim rgSales As Range
Dim i As Long, j As Long
Dim lngCut as Long
Dim res as Variant
res = InputBox("Enter cutoff value")
if res = "" then exit sub
if not isnumeric(res) then Exit sub
lngCut = clng(res)
Set rgSales = Range("A1:D6")
rgSales.Font.ColorIndex = xlAutomatic
For i = 1 To rgSales.Rows.Count
For j = 1 To rgSales.Columns.Count
If rgSales.Cells(i, j).Value < lngCut Then
rgSales.Cells(i, j).Font.ColorIndex = xlAutomatic
Else
rgSales.Cells(i, j).Font.ColorIndex = 3
End If
Next j
Next i
End Sub


--
Regards,
Tom Ogilvy

"ian123" wrote in message
...
Hi,

I've got a code that searches a range and changes the color of any
cells with a value greater than 10,000. Unfortunately, this figure of
10,000 is often subject to changes and as such I have been trying
unsuccessfully to modify the code to include a message that pops up on
screen which will prompt the user (me) to enter the value to identify
and apply the rest of the code to (ie identify and color all cells
above the user entered value).

I have included the code i'm currently using below, can anyone help me
to modify it as desired? Manythanks in advance,
Ian


Sub ColorCells()
Dim rgSales As Range
Dim i As Long, j As Long

Set rgSales = Range("A1:D6")
For i = 1 To rgSales.Rows.Count
For j = 1 To rgSales.Columns.Count
If rgSales.Cells(i, j).Value < 10000 Then
rgSales.Cells(i, j).Font.ColorIndex = 1
Else
rgSales.Cells(i, j).Font.ColorIndex = 3
End If
Next j
Next i
End Sub


---
Message posted from http://www.ExcelForum.com/