Highlighting All the Cells of Active sheet which contains a particular String:

If You want to find any string in whole sheet then Give a try to Below Code:

Code:

---

Sub SelectXCells(strSearch As String)

    Dim rngWhole    As Range
    Dim rngUni      As Range
    Dim lngRow      As Long
    Dim lngCol      As Long
    Dim rngCell    As Range
   
    Set rngWhole = ActiveSheet.UsedRange
    For Each rngCell In rngWhole
        If InStr(1, rngCell, strSearch, vbTextCompare) > 0 Then
            If rngUni Is Nothing Then
                Set rngUni = rngCell
            Else
                Set rngUni = Union(rngUni, rngCell)
            End If
        End If
    Next rngCell
    On Error Resume Next
    rngUni.Select
    On Error GoTo 0
End Sub

---

Example:

Code:

---


Sub Test()

    Dim strFind As String
   
    strFind = InputBox("Please enter string to find", "Find String in Used Range")
    SelectXCells (strFind)
End Sub

---

Littleiitin
Below is what I use - I am just posting it as an alternative - I have no idea if one method is faster than the other.

The code below is what I use to read my default settings (settings selected by the user last time he ran the program) - so that is why the ColDefault has 2 added - so I actually read the last setting for the that variable into ReadValue.

I have all my messages in a module - so just rem out that call to message106

Thanks
Rasm

Code:

---

Public Sub ReadDefault(ValueToFind, ColDefault, RowDefault, ReadValue)
    Dim RangeVal As String
    Dim FoundCell As Range
    Dim LastCell As Range
    Dim LastRow As Long
    Dim ColLast As Long
    With ThisWorkbook.Worksheets("Default_Settings_01").UsedRange
        LastRow = .Rows(.Rows.Count).Row
        ColLast = .Columns(.Columns.Count).Column
    End With
    With ThisWorkbook.Worksheets("Default_Settings_01")
        RangeVal = "A1:" & Split(Cells(1, ColLast).Address, "$")(1) & LastRow
        With .Range(RangeVal)
            Set LastCell = .Cells(.Cells.Count)
        End With
        Astr = ValueToFind
        RangeVal = "A1:" & Split(Cells(1, ColLast).Address, "$")(1) & LastRow
        With .Range(RangeVal)
            Set LastCell = .Cells(.Cells.Count)
        End With
        Set FoundCell = .Range(RangeVal).Find(What:=(Astr), after:=LastCell)
        If FoundCell Is Nothing Then
                Astr = ValueToFind               
                Call Message106(Astr)               
            Else
                ColDefault = FoundCell.Column + 2
                RowDefault = FoundCell.Row
                ReadValue = .Cells(FoundCell.Row, FoundCell.Column + 2)
        End If
    End With
End Sub

---

@ Rahul,

Couple of points

1. Since the Function returns nothing, replace 'Function' with 'Sub'

2. It's case sensitive.
for non case sensitive adjust the code like

Code:

---

If InStr(1, rngCell, strSearch,vbTextCompare) > 0 Then

---

3. Add an error handler. If the search value not found, it gives error.

An alternative function 'FINDALL' can be found here:

http://www.excelfox.com/forum/f13/fi...ction-vba-147/

Thanks Admin,

All Points accepted and incorporated.

Your Find All function is Awesome.

Thanks for All your Guidance.

Regards
Rahul

If you want all string comparisons to be case insensetive then use

Code:

---

Option Compare Text

---

in the declaration section - so very top line of code.

Now you can forget about upper/Lower case conflicts

Yes Rasm,

However in some cases you want this differentiation of Upper and Lower case but for one module you need to avoid , then this is useful.

Thanks

Here is simplest Find All Method

Code:

---


Sub FindallM()
   
    Dim rngFind        As Range
    Dim rngWhole        As Range
    Dim rngUnion        As Range
    Dim rngFirstFind    As Range
    Dim rngFirst
   
    Dim strFind    As String
    On Error Resume Next
    strFind = InputBox("Please Enter string to find")
    If Err.Number = 13 Then
        GoTo x1:
    End If
   
    Set rngWhole = ActiveSheet.UsedRange
    Set rngFind = rngWhole.Find(strFind, , , xlPart, , , False)
    If Not rngFind Is Nothing Then
        Set rngUnion = rngFind
        Set rngFirst = rngFind
        Do
            On Error Resume Next
            Set rngFind = rngWhole.FindNext(rngFind)
            Set rngUnion = Union(rngUnion, rngFind)
        Loop Until rngFind.Address = rngFirst.Address
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        rngUnion.Select
    End If
x1:
End Sub

---