Locate numbers 26 and higher

[NANCY SKYES]

Hello


This my first post so I hope this is clear.


I was looking for help to develop a macro that searches a large number of different ranges for values 26 and higher and to write the cell location results to cells B3, B4, B5 or B6. Some ranges may or may not have sets of numbers in them. I’m only interested in sets of numbers that have a value of 26 (2^nd number in a set of numbers) or higher in them. An example would be 8-26 or 7-35. there will always be data in some of the cell ranges. Please see my sample data below with expected result.


- I can not use a formula because their are issues with some other VBA code I run in the same cell range.
- I need hard code for the search ranges (I have many ranges in different locations on the sheet) so I can add or delete in the code as required. There is data above the cell ranges almost always.
- The sheet name is Sheet 1 and their is only one sheet in the workbook.
- Using Excel 2007.
- The search range cells are formatted as text.
- The write cells are formatted as general.


Sample data:


The code searches ranges D3:D100, F30:F120, H1:H122. The first found set of numbers would be
10-26 in cell D9 and the 2nd positive set of numbers would be 5-35 located in cell F40. The code would then write the cell location to cells B3, B4, B5 or B6. If their are NO positive results could the code write a 0 in cell B3 when finished.


If you have any questions please ask so I can clarify any issue(s).
Thanks so much for all your help.


[h=2][/h] <style type="text/css">h2 { direction: ltr; color: rgb(0, 0, 0); text-align: left; }h2.western { font-family: "Liberation Serif", sans-serif; }h2.cjk { font-family: "WenQuanYi Micro Hei"; }h2.ctl { font-family: "Lohit Devanagari"; }p { margin-bottom: 0.25cm; direction: ltr; color: rgb(0, 0, 0); line-height: 115%; text-align: left; }p.western { font-family: "Liberation Serif", serif; font-size: 12pt; }p.cjk { font-family: "WenQuanYi Micro Hei"; font-size: 12pt; }p.ctl { font-family: "Lohit Devanagari"; font-size: 12pt; }a:link { }</style>

 

[Rick Rothstein]

Are D3:D100, F30:F120 and H1:H122 the only ranges that need to be searched or are there more ranges involved? If more, about how much more?

Are the values in the cells always two numbers (never more) separated by a dash?

 

[NANCY SKYES]

Hi Rick

I have more ranges so I really need a hard code macro so I can add/delete as required. The values in the cell are always two numbers (never more) separated by a dash.

Thank-you so much for your help.

 

[Rick Rothstein]

I have more ranges so I really need a hard code macro so I can add/delete as required. The values in the cell are always two numbers (never more) separated by a dash.

Can you give us an idea of about how many other ranges (better yet, list them for us)? I asked because there are length limits for some of the methods that can be used and I need to know if they will be exceeded or not before choosing a method of attack for you problem.

 

[NANCY SKYES]

Sorry I didn't realize it was an issue but I would say no more than 20 ranges.

 

[Rick Rothstein]

Sorry I didn't realize it was an issue but I would say no more than 20 ranges.

The Range object has a 255 or 256 (I can never remember which) limit on the length of its text argument. I think your 20 ranges should fall within that limit. All you have to do is add the additional ranges to the end of the red highlighted text (use a comma with no space after it as the delimiter).

Sub GreaterThan26()
  Dim X As Long, Rng As Range, Cell As Range, O As Variant, Temp As Variant
  Set Rng = Range("[B][COLOR="#FF0000"]D3:D100,F30:F120,H1:H122[/COLOR][/B]")
  ReDim O(1 To Rng.Count, 1 To 1)
  For Each Cell In Rng
    Temp = Split(Cell.Value, "-")
    If Temp(1) > 26 Then
      X = X + 1
      O(X, 1) = Cell.Address(0, 0)
    End If
  Next
  Range("B1").Resize(UBound(O), 1) = O
End Sub

 

[DanteAmor]

In case you have blank cells or numbers without dash:

Sub Locate_numbers()
  Dim rng As Range, c As Range
  Set rng = Range("D3:D100,F30:F120,H1:H122")
  With CreateObject("scripting.dictionary")
    For Each c In rng
      If Val(Mid(c, InStr(1, c, "-") + 1)) > 26 Then .Item(c.Address(0, 0)) = Empty
    Next
    If .Count = 0 Then [B3] = 0 Else [B3].Resize(.Count) = Application.Transpose(.Keys)
  End With
End Sub

-------------------------------------------------------

Another approach, if you prefer, you can put the ranges in a column, for example "Z". The macro will read all the ranges you have in that column. Sometimes it is more practical to update cells than hard code.

<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:41.82px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:76.04px;" /><col style="width:35.17px;" /><col style="width:35.17px;" /><col style="width:35.17px;" /><col style="width:35.17px;" /><col style="width:35.17px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td><td >H</td><td >I</td><td >J</td><td >K</td><td >Z</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >D3:D100</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td > </td><td >D5</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >F30:F120</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td > </td><td >D6</td><td > </td><td >15-26</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >H1:H122</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td > </td><td >F30</td><td > </td><td >15-27</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td > </td><td >F31</td><td > </td><td >15-28</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td > </td><td >F32</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td > </td><td >F33</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >25</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >26</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >27</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >28</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >29</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >30</td><td > </td><td > </td><td > </td><td > </td><td > </td><td >15-28</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >31</td><td > </td><td > </td><td > </td><td > </td><td > </td><td >15-29</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >32</td><td > </td><td > </td><td > </td><td > </td><td > </td><td >15-30</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >33</td><td > </td><td > </td><td > </td><td > </td><td > </td><td >15-31</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >34</td><td > </td><td > </td><td > </td><td > </td><td > </td><td >15-32</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >35</td><td > </td><td > </td><td > </td><td > </td><td > </td><td >15-33</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >36</td><td > </td><td > </td><td > </td><td > </td><td > </td><td >15-34</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr></table>

Sub Locate_numbers2()
  Dim rng As Range, c As Range, r As Range, nr As Range
  Set rng = [COLOR=#0000ff]Range("Z2", Range("Z" & Rows.Count).End(xlUp))[/COLOR]
  With CreateObject("scripting.dictionary")
    For Each r In rng
    Set nr = Range(r.Value)
      For Each c In nr
        If Val(Mid(c, InStr(1, c, "-") + 1)) > 26 Then .Item(c.Address(0, 0)) = Empty
      Next
    Next
    If .Count = 0 Then [B3] = 0 Else [B3].Resize(.Count) = Application.Transpose(.Keys)
  End With
End Sub

 

[NANCY SKYES]

Hi Rick [h=2]I just tested the code and had an issue with it so I thought I would try to debug the error 9, Subscript out of range on line “If Temp(1) > 26 Then”[/h] [h=2]Does this have to do with Sheet1 that I use in my workbook? I only use one sheet. Thanks so much for your all help.[/h] <style type="text/css">h2 { direction: ltr; color: rgb(0, 0, 0); text-align: left; }h2.western { font-family: "Liberation Serif", sans-serif; }h2.cjk { font-family: "WenQuanYi Micro Hei"; }h2.ctl { font-family: "Lohit Devanagari"; }p { margin-bottom: 0.25cm; direction: ltr; color: rgb(0, 0, 0); line-height: 115%; text-align: left; }p.western { font-family: "Liberation Serif", serif; font-size: 12pt; }p.cjk { font-family: "WenQuanYi Micro Hei"; font-size: 12pt; }p.ctl { font-family: "Lohit Devanagari"; font-size: 12pt; }a:link { }</style>

 

[NANCY SKYES]

Hi Dante

Thank-you for reply. You're very kind with your code. I will keep it for future reference, if needed.
Nancy

 

[DanteAmor]

Hi Dante

Thank-you for reply. You're very kind with your code. I will keep it for future reference, if needed.
Nancy

Hi Nancy,

My first code solves the problem you have with Rick's code, you should try.

Sub Locate_numbers()
  Dim rng As Range, c As Range
  Set rng = Range("[COLOR=#0000ff]D3:D100,F30:F120,H1:H122[/COLOR]")
  With CreateObject("scripting.dictionary")
    For Each c In rng
      If Val(Mid(c, InStr(1, c, "-") + 1)) > 26 Then .Item(c.Address(0, 0)) = Empty
    Next
    If .Count = 0 Then [B3] = 0 Else [B3].Resize(.Count) = Application.Transpose(.Keys)
  End With
End Sub

Good luck