Find a number in a range of a cell

Russk68

Well-known Member
Joined
May 1, 2006
Messages
596
Office Version
  1. 365
Platform
  1. MacOS
Hello all,

I have this # range in cell A1 101>123.
I'm using the > symbol as a thru statement.
My question is; if I put 105 in B1; can a formula or VB return a true by looking at A1 and matching 105.

I would like conditional formatting in B1 to turn green if 105 is in the range of numbers in A1

I also would need to search this range as well; 13/15/19/24

Thank you!
 
You do have a point. The embedded formulas and Conditional Formatting could slow your sheet down. You could remove the CF rules, and the UDF, and replace them with this macro, which needs to be put on the sheet page you want it to run on:

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wk1 As Variant, wk2 As Variant, i As Long, lb As Long, ub As Long
Dim MyData As Variant, r As Long, c As Long, cel As Range
    
    MyData = Range("A1:B100").Value
    
    For Each cel In Target
        If cel.Column = 13 Then
            cel.Interior.Color = xlNone
            For r = 1 To UBound(MyData)
                For c = 1 To UBound(MyData, 2)
                    wk1 = Split(MyData(r, c), "/")
                    For i = 0 To UBound(wk1)
                        wk2 = Split(wk1(i), ">")
                        lb = wk2(0)
                        ub = wk2(UBound(wk2))
                        If cel.Value >= lb And cel.Value <= ub Then
                            cel.Interior.Color = vbGreen
                            Exit Sub
                        End If
                    Next i
                Next c
            Next r
        End If
    Next cel
    
End Sub
The parts you'll need to change are in red, being the range where your rules are, the column number that you want to monitor, and the color you want the cell.

This works for me on a PC, if it doesn't work on a Mac, there's not much I can do to help.
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
You do have a point. The embedded formulas and Conditional Formatting could slow your sheet down. You could remove the CF rules, and the UDF, and replace them with this macro, which needs to be put on the sheet page you want it to run on:
I see one possible problem with the code you posted in Message #21 ... if the user makes a change in the data in Columns A or B that would affect the colors in Column M, the cells in Column M do not update. Here is code which should handle both, a change in Columns A or B and a change in Column M (where the numbers be be checked are assumed to be). Note that the code goes in two modules (a general code module and the specific worksheet code module).
Code:
[B][COLOR="#008000"]' Place this code in a general code module[/COLOR][/B]

Public Combined As String
Code:
[table="width: 500"]
[tr]
	[td][B][COLOR="#008000"]' Place this code in the worksheet's code module[/COLOR][/B]

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cell As Range, MCell As Range
  If Len(Combined) = 0 Then CreateCombined
  If Intersect(Columns("[B][COLOR="#FF0000"][COLOR="#FF0000"]A:B[/COLOR][/COLOR][/B]"), Target) Is Nothing Then
    Combined = ""
    For Each Cell In Target
      If Cell.Column = [B][COLOR="#FF0000"]13[/COLOR][/B] Then Cell.Interior.Color = IIf(1 - (InStr(Combined, Cell.Value) > 0), vbGreen, xlNone)
    Next
  Else
    CreateCombined
    For Each Cell In Range("[B][COLOR="#FF0000"]M1[/COLOR][/B]", Cells(Rows.Count, "[B][COLOR="#FF0000"]M[/COLOR][/B]").End(xlUp))
      Cell.Interior.Color = IIf(InStr(Combined, "/" & Cell.Value & "/") > 0, vbGreen, xlNone)
    Next
  End If
End Sub

Sub CreateCombined()
  Dim X As Long, Z As Long, Arr As Variant, Nums As Variant
  Arr = Split(Join(Application.Transpose(Range("[B][COLOR="#FF0000"]A1:A[/COLOR][/B]" & Cells(Rows.Count, "[B][COLOR="#FF0000"]A[/COLOR][/B]").End(xlUp).Row + 1).Value), "/") & _ 
              Join(Application.Transpose(Range("[B][COLOR="#FF0000"]B1:B[/COLOR][/B]" & Cells(Rows.Count, "[B][COLOR="#FF0000"]B[/COLOR][/B]").End(xlUp).Row).Value), "/"), "/")
  For X = 1 To UBound(Arr)
    Nums = Split(Arr(X), "/")
    For Z = 0 To UBound(Nums)
      If InStr(Nums(Z), ">") Then Arr(X) = Join(Evaluate("TRANSPOSE(ROW(" & Replace(Nums(Z), ">", ":") & "))"), "/")
    Next
  Next
  Combined = "/" & Join(Arr, "/") & "/"
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Hi Rick,
That is correct and I was going to ask Eric about that. His code works great in Windows!
The columns that I applied this to have changed since the original post. Column A is where I enter values (101 or 206 or 592 and so on). AE1:AP220 is where these type of number formats appear (101 or 201>204 or 201/203/205). Cells in column A will highlight when a match is found in AE1:AP220
I followed your instructions above and I also changed your code below a little to match up with what I am doing but I only put values in column AE to test it. What I found is that every value in column A highlighted in green even if there was no match. I'm guessing it's from my changes because I really don't know VBA that well.
An issue that I just realized is that when a value in column A is TRUE and highlights green, it needs to return black if it changes to false. Also, Values in column A are quite often dragged down to quickly fill in sequential numbers and I'm thinking that it will drag the formatting as well which is ok if it updates with the next change.
Think it's possible?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range, MCell As Range
If Len(Combined) = 0 Then CreateCombined
If Intersect(Columns("AE:AP"), Target) Is Nothing Then
Combined = ""
For Each Cell In Target
If Cell.Column = 1 Then Cell.Font.Color = IIf(1 - (InStr(Combined, Cell.Value) > 0), vbGreen, xlNone)
Next
Else
CreateCombined
For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
Cell.Font.Color = IIf(InStr(Combined, "/" & Cell.Value & "/") > 0, vbGreen, xlNone)
Next
End If
End Sub

Sub CreateCombined()
Dim X As Long, Z As Long, Arr As Variant, Nums As Variant
Arr = Split(Join(Application.Transpose(Range("AE1:AE" & Cells(Rows.Count, "AE").End(xlUp).Row + 1).Value), "/") & _
Join(Application.Transpose(Range("AF1:AF" & Cells(Rows.Count, "AF").End(xlUp).Row).Value), "/"), "/")
For X = 1 To UBound(Arr)
Nums = Split(Arr(X), "/")
For Z = 0 To UBound(Nums)
If InStr(Nums(Z), ">") Then Arr(X) = Join(Evaluate("TRANSPOSE(ROW(" & Replace(Nums(Z), ">", ":") & "))"), "/")
Next
Next
Combined = "/" & Join(Arr, "/") & "/"
End Sub

(over 30,000 posts?! omg!)
Thank you very much!
 
Upvote 0
Hi Eric,
I'll be using your solution on my Windows machine while trying to convince my other collogues to load Windows for this and other reasons.
Rick chimed in with a suggestion as well so you can take a (short) break from me!

Thank you for all your help!
 
Upvote 0
I see one possible problem with the code you posted in Message #21 ... if the user makes a change in the data in Columns A or B that would affect the colors in Column M, the cells in Column M do not update.

Good catch! And based on Russk68's latest post, that matters. Your code is as slick as I've come to expect. I particularly like how you used the Global variable to hold the rules, meaning they don't need to be recalculated each time.

However, when I actually tried to load the code, I ran into some issues, some of which Russ also seems to have hit. First was the "Arr = " line. I could NOT get that to work, not on my Excel 365 at work, or 2013 at home. Particularly frustrating since I could break the line into pieces and run them individually in the Immediate window and they worked. Since Russ didn't seem to have that issue, I wrote a workaround. But as it happens, with the change in ranges Russ mentioned, it turned out to be handy.

One thing confused me: what's the point of the
Code:
Combined = ""
line? And why is the Instr line 2 lines below it different from the Instr line 5 lines below that? Those 2 lines seem to insure that every cell will be highlighted. And finally, one little tweak:
Code:
For X = 1 to UBound(Arr)
should be
Code:
For X = 0 to UBound(Arr)
. Given those changes, I rewrote the code a bit:

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cell As Range, FullRange As Range, RuleChange As Boolean
  Set FullRange = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  RuleChange = IIf(Intersect(Columns("AE:AP"), Target) Is Nothing, False, True) Or (Len(Combined) = 0)
  If RuleChange Then CreateCombined
  For Each Cell In Intersect(FullRange, IIf(RuleChange, FullRange, Target))
    Cell.Interior.Color = IIf(InStr(Combined, "/" & Cell.Value & "/") > 0, vbGreen, xlNone)
  Next
End Sub

Sub CreateCombined()
  Dim X As Long, Z As Long, Arr As Variant, Nums As Variant, str1 As String, Cell As Range
  For Each Cell In Range("AE1:AP220")
    str1 = str1 & Cell.Value & IIf(Cell.Value <> "", "/", "")
  Next Cell
  If Len(str1) > 0 Then str1 = Left(str1, Len(str1) - 1)
  Arr = Split(str1, "/")
  For X = 0 To UBound(Arr)
    Nums = Split(Arr(X), "/")
    For Z = 0 To UBound(Nums)
      If InStr(Nums(Z), ">") Then Arr(X) = Join(Evaluate("TRANSPOSE(ROW(" & Replace(Nums(Z), ">", ":") & "))"), "/")
    Next
  Next
  Combined = "/" & Join(Arr, "/") & "/"
End Sub
I'm sure it can still be improved.
 
Last edited:
Upvote 0
Your code is as slick as I've come to expect. I particularly like how you used the Global variable to hold the rules, meaning they don't need to be recalculated each time.
You think my code is "slick"? Thank you... that is mighty kind of you to say.



However, when I actually tried to load the code, I ran into some issues, some of which Russ also seems to have hit. First was the "Arr = " line. I could NOT get that to work, not on my Excel 365 at work, or 2013 at home. Particularly frustrating since I could break the line into pieces and run them individually in the Immediate window and they worked. Since Russ didn't seem to have that issue, I wrote a workaround. But as it happens, with the change in ranges Russ mentioned, it turned out to be handy.

One thing confused me: what's the point of the
Code:
Combined = ""
line? And why is the Instr line 2 lines below it different from the Instr line 5 lines below that? Those 2 lines seem to insure that every cell will be highlighted. And finally, one little tweak:
Code:
For X = 1 to UBound(Arr)
should be
Code:
For X = 0 to UBound(Arr)
.
I don't think the code I posted was the code I had gotten to finally work, especially since it doesn't work correctly all the time now. Anyway, I went back and fixed the code (back to what I think I remember it being when it worked). Here is the fixed code which I believe now works correctly...
Code:
[B][COLOR="#008000"]' Place this code in a general code module[/COLOR][/B]

Public Combined As String
Code:
[table="width: 500"]
[tr]
	[td][B][COLOR="#008000"]' Place this code in the worksheet's code module[/COLOR][/B]

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cell As Range, MCell As Range
  If Len(Combined) = 0 Then CreateCombined
  If Intersect(Columns("A:B"), Target) Is Nothing Then
    For Each Cell In Target
      If Cell.Column = 13 Then Cell.Interior.Color = IIf(InStr(Combined, "/" & Cell.Value & "/") > 0, vbGreen, xlNone)
    Next
  Else
    CreateCombined
    For Each Cell In Range("M1", Cells(Rows.Count, "M").End(xlUp))
      Cell.Interior.Color = IIf(InStr(Combined, "/" & Cell.Value & "/") > 0, vbGreen, xlNone)
    Next
  End If
End Sub

Sub CreateCombined()
  Dim X As Long, Z As Long, Arr As Variant, Nums As Variant
  Arr = Split(Join(Application.Transpose(Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).Value), "/") & _
              Join(Application.Transpose(Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row + 1).Value), "/"), "/")
  For X = 0 To UBound(Arr)
    Nums = Split(Arr(X), "/")
    For Z = 0 To UBound(Nums)
      If InStr(Nums(Z), ">") Then Arr(X) = Join(Evaluate("TRANSPOSE(ROW(" & Replace(Nums(Z), ">", ":") & "))"), "/")
    Next
  Next
  Combined = Replace("/" & Join(Arr, "/") & "/", "//", "/")
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Actually, the range references are for the OP's original layout. I am going to sleep now so I adjust the code for the new ranges when I get up.
@Russk68,

Here is my latest (fixed) code modified for the ranges you mentioned in Message #23 ...
Code:
[B][COLOR="#008000"]' Place this code in a general code module[/COLOR][/B]

Public Combined As String
Code:
[table="width: 500"]
[tr]
	[td][B][COLOR="#008000"]' Place this code in the worksheet's code module[/COLOR][/B]

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cell As Range, MCell As Range
  If Len(Combined) = 0 Then CreateCombined
  If Intersect(Columns("AE:AP"), Target) Is Nothing Then
    For Each Cell In Target
      If Cell.Column = 1 Then Cell.Interior.Color = IIf(InStr(Combined, "/" & Cell.Value & "/") > 0, vbGreen, xlNone)
    Next
  Else
    CreateCombined
    For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
      Cell.Interior.Color = IIf(InStr(Combined, "/" & Cell.Value & "/") > 0, vbGreen, xlNone)
    Next
  End If
End Sub

Sub CreateCombined()
  Dim X As Long, Z As Long, Combo As String, Arr As Variant, Nums As Variant
  For X = 31 To 42 'Columns AE to AP
    Combo = Combo & "/" & Join(Application.Transpose(Range(Cells(1, X), Cells(Rows.Count, X).End(xlUp).Offset(1)).Value), "/")
  Next
  Arr = Split(Combo, "/")
  For X = 0 To UBound(Arr)
    Nums = Split(Arr(X), "/")
    For Z = 0 To UBound(Nums)
      If InStr(Nums(Z), ">") Then Arr(X) = Join(Evaluate("TRANSPOSE(ROW(" & Replace(Nums(Z), ">", ":") & "))"), "/")
    Next
  Next
  Combined = "/" & Join(Arr, "/") & "/"
  Do While InStr(Combined, "//")
    Combined = Replace(Combined, "//", "/")
  Loop
End Sub
[/td]
[/tr]
[/table]
 
Upvote 0
Hi Rick
I will give this a try tomorrow and get back to you.
Thank you very much!
 
Upvote 0
Rick and Eric
Works great!
Thank you very much for all your help.


Russ
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top