VBA- Search Cells for a Number Between a Specified Min & Max.

[SEANRYAN93]

I like the ctrl and F feature on excel. It sends me to the cell containing my search request.

However, I need to search for a cell containing between 1200 and 1210 for example. (due to currency conversions)


I cannot filter between values due to the formatting of the report.

I found something I thought might work on ozgrid.com (http://www.ozgrid.com/VBA/find-between.htm) but I've not been able to test it due to a syntax error, can anyone help with the macro below or suggest something new?

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