One way:

Public Sub ColorCells()
Dim result As Variant
Dim rCell As Range

Do
result = Application.InputBox( _
Prompt:="Enter breakpoint:", _
Title:="ColorCells()", _
Default:=10000, _
Type:=1)
If result = False Then Exit Sub 'user clicked Cancel
Loop Until result < ""
For Each rCell In Range("A1:D6")
With rCell
If .Value < result Then
.Font.ColorIndex = 1
Else
.Font.ColorIndex = 3
End If
End With
Next rCell
End Sub

It would be a bit shorter to use

With rCell
.Font.ColorIndex = 3 + 2 * (.Value < result)
End With

Note that you could also use Conditional Formatting, and avoid
looping through your range:

Public Sub ColorCells()
Dim result As Variant
Do
result = Application.InputBox( _
Prompt:="Enter breakpoint:", _
Title:="ColorCells()", _
Default:=10000, _
Type:=1)
If result = False Then Exit Sub 'user clicked Cancel
Loop Until result < ""
With Range("A1:D6")
.FormatConditions.Delete
.FormatConditions.Add _
Type:=xlCellValue, _
Operator:=xlGreater, _
Formula1:=result
.FormatConditions(1).Font.ColorIndex = 3
End With
End Sub



In article ,
ian123 wrote:

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/