 |
| FREE Excel STUFF |
Search |
| PRODUCTS |
| Development |
| Contact |
Excel Online |
|
Complete Excel Excel Training Course. Instant Buy/Download, 30 Day Money Back Guarantee FREE DOWNLOADS SmartVBA | SmartVB6 | CodeVBA | CodeVB6 | Code Generator Pro | TraderXL Pro Package. MORE.. |
Got any Excel Questions? Free Excel Help
<See Also: Get Maximum Number Between 2 Numbers Custom Function | Advanced Excel Find | Excel Find & Replace>
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
<See Also: Get Maximum Number Between 2 Numbers Custom Function | Advanced Excel Find | Excel Find & Replace>
Excel Dashboard Reports & Excel Dashboard Charts 50% Off
Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to special@ozgrid.com 31 days after purchase date.
Instant Download and Money Back Guarantee on Most Software
Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!
Microsoft ® and Microsoft Excel ® are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft
