View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Dick Kusleika Dick Kusleika is offline
external usenet poster
 
Posts: 179
Default I Tried it, still problem...

Jim

OK, I think I got. Test this out and let me know if you run into problems.

Sub FindStuff()

Dim FndRng As Range
Dim FirstAdd As String
Dim i As Long, j As Long
Dim FWhat As Variant
Dim SrchRng As Range
Dim Cell As Range
Dim LastCol As Long
Dim ExactMatch As Boolean

Sheets("TEMP").Cells.ClearContents

With Sheets("FINDER").Range("g9")
Do Until .Value = Replace(.Value, " ", " ")
.Value = Replace(.Value, " ", " ")
Loop
.Value = Replace(.Value, ",", "")

'You need XL2000 or newer to use the Split function
FWhat = Split(.Value, " ")
End With

'Loop through the words in G9
For j = LBound(FWhat) To UBound(FWhat)

If j = LBound(FWhat) Then
Set SrchRng = Sheets("SCIT").Cells
Else
Set SrchRng = Sheets("TEMP").Columns(j).Cells
End If

Set FndRng = SrchRng.Find( _
what:=FWhat(j) & Chr(32), _
after:=SrchRng.Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

'If value is not found, FndRng will be Nothing
If Not FndRng Is Nothing Then

'Store the first address found
FirstAdd = FndRng.Address

'Start the loop
Do

'Write to the sheet
Sheets("TEMP").Range("a1").Offset(i, j).Value = _
FndRng.Value

'Find the next occurrence
Set FndRng = SrchRng.Find( _
what:=FWhat(j) & Chr(32), _
after:=FndRng, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

'increment the offset
i = i + 1

'Stop looping when it cycles back to the first one
Loop Until FndRng.Address = FirstAdd

End If
i = 0
Next j

LastCol = UBound(FWhat) - LBound(FWhat) + 1

With Sheets("TEMP")
For Each Cell In .Range(.Cells(1, UBound(FWhat) + 1), _
.Cells(65536, UBound(FWhat) + 1).End(xlUp))

If Len(Cell.Value) - Len(Replace(Cell.Value, " ", "")) = _
LastCol Then

.Cells(i + 1, LastCol + 1).Value = Cell.Value
ExactMatch = True
i = i + 1
End If
Next Cell

If Not ExactMatch Then
.Cells(i + 1, LastCol + 1).Value = "No exact match"
End If
End With

End Sub

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"-JB-" wrote in message
...
Dick,

Oops, step 4.) of my last post is flawed. It should, intead of
searching for an exact match, search for a result that contains the
same amount of words as the query. That would produce the
exact/inverted match. If this is not possible, or it is difficult to
code, the macro would still be very useful to me (if you ended the
macro at step 3; skipping step 4).

Jim



------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/