Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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)!!! |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 "ian123" wrote in message ... 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/ |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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/ |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
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!!! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Searching Multiple Timesheets for a project code and then.... | Excel Worksheet Functions | |||
VBA code to searching for a folder | Excel Discussion (Misc queries) | |||
searching by number or code ina work book | Excel Discussion (Misc queries) | |||
Searching for VB Code to Link to Program | Excel Programming | |||
How to protect single cell or cells range from being over-written? | Excel Programming |