Excel VBA: Find Number Between 2 Numbers

< Back to Search results

 Category: [Excel]  Demo Available 

Excel VBA: Find Number Between 2 Numbers


Search Cells for a Number Between a Specified Min & Max

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)


            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


            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



        rStart .Select


         If bNoFind = True Then

             MsgBox "No numbers between " _

             & lMin & " and " & lMax, vbInformation, "Ozgrid.com"

         End If

        On Error GoTo 0

End Sub

 See also:

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


See also Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions.


Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.


stars (0 Reviews)