match words and extract out

Hi, mathanraj76,

you should attach a sample that reflects what you are asking for, not one where everything has been resolved. I think you have been told so on the last thread as well: show the situation as is and the expected result. No Tommy in Sheet1 or Sheet2, no possible matches from Sheet1 in Sheet2 left, no outcome.

Ciao,
Holger

Hi, mathanraj76,

you would need to supply a sample which holds the origiunal data for each and every record you have put into Outcome as a sample in Sheet1 - I doubt itīs good practise to feature LOT PT 8070, JALAN 82/26, MUKIM SETAPAK in Output with no match in Sheet2. And neither CHIN HO-(HO) KUALA LUMPUR (B)-LCSB nor DAIE ENG. SB from Sheet1 are listed on Sheet2.

So what shall we code for if there is nothing to match? You would need to deliver samples for this question.

Ciao,
Holger

Hi, mathanraj76,

I wouldnīt search for just a single character like 5 or B which could lead to some unwanted results. Thatīs where an unique identifier would come in very handy.

Sub EF977853()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lngCounter As Long
Dim var As Variant
Dim strSearch As String

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("output")

With ws1
  For lngCounter = 2 To .Range("A" & Rows.Count).End(xlUp).Row
    var = Split(.Cells(lngCounter, "A").Value, " ")
    If WorksheetFunction.CountIf(ws2.Range("A:A"), var(0) & "*") > 0 Then
      ws3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 11).Value = _
          .Range("A" & lngCounter).Resize(1, 11).Value
      .Range("A" & lngCounter).Resize(1, 11).ClearContents
    End If
  Next lngCounter
End With

Set ws3 = Nothing
Set ws2 = Nothing
Set ws1 = Nothing

End Sub

Ciao,
Holger