Method or VBA script to select any cells below a certain value in a selection of data

[justin_n84]

Hi,

I'm looking for a method or VBA script to select any cells below a certain value (for example 5.1) in a selection of data.

Any help would be greatly appreciated.

Thanks in advance

 

[footoo]

Dim cel As Range, rng As Range
For Each cel In Selection
    If cel < 5.1 Then
        If rng Is Nothing Then
            Set rng = cel
        Else
            Set rng = Union(rng, cel)
        End If
    End If
Next
rng.Select

 

[nemmi69]

Hope this helps

Option Explicit


Dim LastRowNo As Long
Dim Rloop As Long
Dim RangeStr As String


Sub MinValRangeSelect()
LastRowNo = Range("A65536").End(xlUp).Row 'Just to set list of names


If LastRowNo > 1 Then
    RangeStr = ""
    For Rloop = 1 To LastRowNo
        If Range("A" & Rloop).Value < 5.1 Then
            RangeStr = RangeStr & "A" & Range("A" & Rloop).Row & ","
        End If
    Next Rloop
    If Len(RangeStr) > 0 Then
        RangeStr = Left(RangeStr, Len(RangeStr) - 1)
    End If
    Range(RangeStr).Select
End If
End Sub

 

[footoo]

Amended :

Sub FT()
Dim cel As Range, rng As Range[COLOR=#ff0000]
For Each cel In Intersect(Selection, ActiveSheet.UsedRange)[/COLOR]
    If cel < 5.1 Then
        If rng Is Nothing Then
            Set rng = cel
        Else
            Set rng = Union(rng, cel)
        End If
    End If
Next
[COLOR=#ff0000]If Not rng Is Nothing Then rng.Select[/COLOR]
End Sub

 

[Rick Rothstein]

If all of the cells being selected are constants (that is, there are no formulas in the cells), then this completely different method than what has been posted to date will also do what you want...

[table="width: 500"]
[tr]
	[td]Sub SelectLessThan5point1WithinSelection()
  Dim LessThanValue As Double, Addr As String, Data As Variant
  LessThanValue = [B][COLOR="#FF0000"]5.1[/COLOR][/B]
  On Error GoTo NoValues
  Intersect(Selection, ActiveSheet.UsedRange).Select
  Data = Selection.Value
  Addr = Selection.Address
  Selection = Evaluate(Replace("IF(@="""","""",SUBSTITUTE(@-" & LessThanValue & ",""-"",""=""))", "@", Selection.Address))
  Selection.SpecialCells(xlFormulas).Select
  Range(Addr) = Data
NoValues:
End Sub[/td]
[/tr]
[/table]

 

[footoo]

If all of the cells being selected are constants (that is, there are no formulas in the cells), then this completely different method than what has been posted to date will also do what you want...

[/FONT][TABLE="width: 500"]
<tbody>[TR]
[TD]Sub SelectLessThan5point1WithinSelection()
  Dim LessThanValue As Double, Addr As String, Data As Variant
  LessThanValue = [B][COLOR=#FF0000]5.1[/COLOR][/B]
  On Error GoTo NoValues
  Intersect(Selection, ActiveSheet.UsedRange).Select
  Data = Selection.Value
  Addr = Selection.Address
  Selection = Evaluate(Replace("IF(@="""","""",SUBSTITUTE(@-" & LessThanValue & ",""-"",""=""))", "@", Selection.Address))
  Selection.SpecialCells(xlFormulas).Select
  Range(Addr) = Data
NoValues:
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
[FONT=Verdana]

Needs amendment to accommodate when there are no values less than 5.1

 

[footoo]

Needs amendment to accommodate when there are no values less than 5.1

Sub SelectLessThan5point1WithinSelection()
Dim LessThanValue As Double, Addr As String, Data As Variant
LessThanValue = 5.1
On Error GoTo NoValues
Intersect(Selection, ActiveSheet.UsedRange).Select
Data = Selection.Value
Addr = Selection.Address
Selection = Evaluate(Replace("IF(@="""","""",SUBSTITUTE(@-" & LessThanValue & ",""-"",""=""))", "@", Selection.Address))
Selection.SpecialCells(xlFormulas).Select
[COLOR=#ff0000]NoValues:[/COLOR]
[COLOR=#ff0000]Range(Addr) = Data[/COLOR]
End Sub

 

[Rick Rothstein]

Needs amendment to accommodate when there are no values less than 5.1

Good catch!

Sub SelectLessThan5point1WithinSelection()
Dim LessThanValue As Double, Addr As String, Data As Variant
LessThanValue = 5.1
On Error GoTo NoValues
Intersect(Selection, ActiveSheet.UsedRange).Select
Data = Selection.Value
Addr = Selection.Address
Selection = Evaluate(Replace("IF(@="""","""",SUBSTITUTE(@-" & LessThanValue & ",""-"",""=""))", "@", Selection.Address))
Selection.SpecialCells(xlFormulas).Select
[COLOR=#ff0000]NoValues:[/COLOR]
[COLOR=#ff0000]Range(Addr) = Data[/COLOR]
End Sub

I never tested the code for none of the cells meeting the condition (stupid of me not to). What you posted above is the correct fix. Thank you for that.