ExcelBanter - Searching range for value (code written but needs 'tweaking'!)

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Searching range for value (code written but needs 'tweaking'!) (https://www.excelbanter.com/excel-programming/286118-searching-range-value-code-written-but-needs-tweaking.html)

ian123[_26_]

Searching range for value (code written but needs 'tweaking'!)

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/

Tom Ogilvy

Searching range for value (code written but needs 'tweaking'!)

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/

J.E. McGimpsey

Searching range for value (code written but needs 'tweaking'!)

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/

ian123[_27_]

Searching range for value (code written but needs 'tweaking'!)

Thanks guys, its working great now!

May i pick your brains on 2 other quick points? Firstly, is it
possible to modify the macro to apply it to a user highlighted
selection rather than the range a1:d6

Secondly, can anyone explain how i can add a second box, similar to the
first but that will find and color a number below a certain amount.
I'm sure i'll be able to copy and modify the old code but how do i get
the macro to bring up the first box and then bring up the second
box...

I appreciate that you have already helped me greatly with your advice
so understand if you have others to help. Once again many thanks for
your advice and consideration of my problem(s)!!!

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

Tom Ogilvy

Searching range for value (code written but needs 'tweaking'!)

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/

J.E. McGimpsey

Searching range for value (code written but needs 'tweaking'!)

If I understand you correctly:

Public Sub ColorCells()
Dim result1 As Variant
Dim result2 As Variant
Do
result1 = Application.InputBox( _
Prompt:="Color red above:", _
Title:="ColorCells()", _
Default:=10000, _
Type:=1)
If result1 = False Then Exit Sub 'user clicked Cancel
Loop Until result1 < ""
Do
result2 = Application.InputBox( _
Prompt:="Color green below:", _
Title:="ColorCells()", _
Default:=1000, _
Type:=1)
If result2 = False Then Exit Sub 'user clicked Cancel
Loop Until result2 < ""
With Selection
.FormatConditions.Delete
With .FormatConditions.Add( _
Type:=xlCellValue, _
Operator:=xlGreater, _
Formula1:=result1)
.Font.ColorIndex = 3
End With
With .FormatConditions.Add( _
Type:=xlCellValue, _
Operator:=xlLess, _
Formula1:=result2)
.Font.ColorIndex = 10
End With
End With
End Sub

In article ,
ian123 wrote:

Thanks guys, its working great now!

May i pick your brains on 2 other quick points? Firstly, is it
possible to modify the macro to apply it to a user highlighted
selection rather than the range a1:d6

Secondly, can anyone explain how i can add a second box, similar to the
first but that will find and color a number below a certain amount.
I'm sure i'll be able to copy and modify the old code but how do i get
the macro to bring up the first box and then bring up the second
box...

I appreciate that you have already helped me greatly with your advice
so understand if you have others to help. Once again many thanks for
your advice and consideration of my problem(s)!!!

Tom Ogilvy

Searching range for value (code written but needs 'tweaking'!)

ian123[_28_]

Searching range for value (code written but needs 'tweaking'!)

Thanks very much, working exactly as i hoped. There is one thing left
to 'tweak' if i may be so bold... on running the macro if there are any
text cells in the selection the color of these entries are changed to.

Is it possible to avoid this? If not, don't worry about it - its a
small iritation to live with!!!

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

J.E. McGimpsey

Searching range for value (code written but needs 'tweaking'!)

one way:

Public Sub ColorCells()
Dim result1 As Variant
Dim result2 As Variant
Dim rFormat As Range
Do
result1 = Application.InputBox( _
Prompt:="Color red above:", _
Title:="ColorCells()", _
Default:=10000, _
Type:=1)
If result1 = False Then Exit Sub 'user clicked Cancel
Loop Until result1 < ""
Do
result2 = Application.InputBox( _
Prompt:="Color green below:", _
Title:="ColorCells()", _
Default:=1000, _
Type:=1)
If result2 = False Then Exit Sub 'user clicked Cancel
Loop Until result2 < ""
With Selection
On Error Resume Next
Set rFormat = Union(.SpecialCells( _
xlCellTypeConstants, xlNumbers), _
.SpecialCells(xlCellTypeFormulas, xlNumbers))
On Error GoTo 0
If Not rFormat Is Nothing Then
With rFormat
.FormatConditions.Delete
With .FormatConditions.Add( _
Type:=xlCellValue, _
Operator:=xlGreater, _
Formula1:=result1)
.Font.ColorIndex = 3
End With
With .FormatConditions.Add( _
Type:=xlCellValue, _
Operator:=xlLess, _
Formula1:=result2)
.Font.ColorIndex = 10
End With
End With
End If
End With
End Sub

In article ,
ian123 wrote:

Thanks very much, working exactly as i hoped. There is one thing left
to 'tweak' if i may be so bold... on running the macro if there are any
text cells in the selection the color of these entries are changed to.

Is it possible to avoid this? If not, don't worry about it - its a
small iritation to live with!!!

All times are GMT +1. The time now is 10:26 PM.