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

[littleiitin]

If You want to find any string in whole sheet then Give a try to Below 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:



Sub Test()

Dim strFind As String

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

[Rasm]

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



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

[Admin]

@ 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

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/findall-function-vba-147/

[littleiitin]

Thanks Admin,

All Points accepted and incorporated.

Your Find All function is Awesome.

Thanks for All your Guidance.

Regards
Rahul

[Rasm]

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


Option Compare Text


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

Now you can forget about upper/Lower case conflicts

[littleiitin]

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

[littleiitin]

Here is simplest Find All Method



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