Hi Giri,
I kept getting pulled away, but had started on this. See if this helps...
Option Explicit
Sub exa()
Dim strSearchFor As String
Dim strFirstAddress As String
Dim rngSearch As Range
Dim rngFoundCell As Range
Dim rngCells As Range
strSearchFor = InputBox("What do you want to find?", "Search")
'// In case user doesn't enter anything to search for... //
If strSearchFor = vbNullString Then Exit Sub
Set rngSearch = Range("A1:X100")
'// See if we find the string at least once. //
Set rngFoundCell = RangeFound(rngSearch, strSearchFor, , xlValues, xlWhole)
If Not rngFoundCell Is Nothing Then
'// Save the address of the first found cell, so we'll know when to quit. //
strFirstAddress = rngFoundCell.Address
'// Create another reference so we can "collect up" all the cells found. //
Set rngCells = rngFoundCell
Do
'// Keep looking until we run back into our first found cell, adding //
'// to our 'collection' of found cells. //
Set rngFoundCell = rngSearch.FindNext(rngFoundCell)
Set rngCells = Application.Union(rngCells, rngFoundCell)
Loop While Not rngFoundCell.Address = strFirstAddress
'// Then run through all the cells found ... //
For Each rngFoundCell In rngCells
rngFoundCell.Offset(, 1).Value = rngFoundCell.Value
rngFoundCell.Offset(, 1).Interior.Color = vbRed
Next
End If
End Sub
Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range
If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If
Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
Mark