Got any Excel/VBA Questions? Free Excel Help
Find Number Between 2 Numbers
Excel and most MS Office Applications, have a Find feature than can be use to find a specified value, or text string, in a range, Worksheet, or Workbook. However, no such feature exists where we can tell Excel to find the first occurrence of a number that is between a Minimum number and a maximum number. We can however use some Excel VBA macro code to do it for us.
Loops Are Too Slow
Most would go with a loop to get a number between a nominated range . However, this can be extremely slow and horribly inefficient if the Worksheet contain thousands of used cells. The method below makes use of the SpecialCells method to ensure we are only checking numeric cells.
Search All Cells or Only Selection
The code works in the same way as the standard Find feature does. That is, search ALL cells on the Worksheet if only a single cell is selected, or search ONLY the selected cells if more than one cell is selected.
If will locate and select the first cell, that has a value between (not equal to) the specified min and max. It searches by rows. Note, it will not locate a zero value.
Sub GetBetween() Dim strNum As String Dim lMin As Long, lMax As Long Dim rFound As Range, rLookin As Range Dim lFound As Long, rStart As Range Dim rCcells As Range, rFcells As Range Dim lCellCount As Long, lcount As Long Dim bNoFind As Boolean strNum = InputBox("Please enter the lowest value, then a comma, " _ & "followed by the highest value" & vbNewLine & _ vbNewLine & "E.g. 1,10", "GET BETWEEN") If strNum = vbNullString Then Exit Sub On Error Resume Next lMin = Left(strNum, InStr(1, strNum, ",")) If Not IsNumeric(lMin) Or lMin = 0 Then MsgBox "Error in your entering of numbers, or Min was a zero", vbCritical, "Ozgrid.com" Exit Sub End If lMax = Replace(strNum, lMin & ",", "") If Not IsNumeric(lMax) Or lMax = 0 Then MsgBox "Error in your entering of numbers, or Max was a zero", vbCritical, "Ozgrid.com" Exit Sub End If If lMax < lMin Then MsgBox "Min is greater than Max", vbCritical, "Ozgrid.com" Exit Sub End If If lMin + 1 = lMax Then MsgBox "No scope between Min and Max", vbCritical, "Ozgrid.com" Exit Sub End If If Selection.Cells.Count = 1 Then Set rCcells = Cells.SpecialCells(xlCellTypeConstants, xlNumbers) Set rFcells = Cells.SpecialCells(xlCellTypeFormulas, xlNumbers) Set rStart = Cells(1, 1) Else Set rCcells = Selection.SpecialCells(xlCellTypeConstants, xlNumbers) Set rFcells = Selection.SpecialCells(xlCellTypeFormulas, xlNumbers) Set rStart = Selection.Cells(1, 1) End If 'Reduce down range to look in If rCcells Is Nothing And rFcells Is Nothing Then MsgBox "You Worksheet contains no numbers", vbCritical, "ozgrid.com" Exit Sub ElseIf rCcells Is Nothing Then Set rLookin = rFcells.Cells 'formulas ElseIf rFcells Is Nothing Then Set rLookin = rCcells.Cells 'constants Else Set rLookin = Application.Union(rFcells, rCcells) 'Both End If lCellCount = rLookin.Cells.Count Do Until lFound > lMin And lFound < lMax And lFound > 0 lFound = 0 Set rStart = rLookin.Cells.Find(What:="*", After:=rStart , LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, _ SearchDirection:=xlNext, MatchCase:=True) lFound = rStart .Value lcount = lcount + 1 If lCellCount = lcount Then bNoFind = True Exit Do End If Loop rStart .Select If bNoFind = True Then MsgBox "No numbers between " _ & lMin & " and " & lMax, vbInformation, "Ozgrid.com" End If On Error GoTo 0 End Sub
|Excluding Headings/Headers From the Current Region/Table|
|Excel: Get Text From Excel Cell Comments|
|Excel: Get Data From Closed Excel Workbooks|
|Excel: Get Last Word From Text String|
|Extract Number From Text String|
|Excel VBA: Extract Word From a Text String|