SEANRYAN93
New Member
- Joined
- Jun 19, 2018
- Messages
- 1
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
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