Hello Excel Gurus,

I have the code below that needs minor revision. Right now it only display the exact match when found.

The revision I want is if I type “ENGLISH” on cell “A2”, it will display all the Description that contain the word “ENGLISH” whether it is “ENGLISH/SPANISH” or “ENGLISH VERSION”, “SPANISH/ENGLISH”, “English/Italian”, “Spanish-Eng”, etc. as long as the cell contain the word “ENGLISH" whether in the beginning, middle or last. (Lower or upper case). Maybe a search with wild (*) character.

Also, if 2 or more exact match is found, display only one. (remove duplicate)

I am newbie on writing a Macro.

Any help would be appreciated.

Thank you.

HERE IS THE CODE
Option Explicit
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng         As Range
Dim Dn          As Range
Dim Dic         As Object
Dim Temp        As String
Dim oCols       As String
Dim R           As Range
Dim C           As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

With Sheets("DATA1")
    Set Rng = .Range(.Range("Q1"), .Range("Q" & Rows.Count).End(xlUp))
End With

Set Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
C = 5
For Each Dn In Rng
    If Not Dic.exists(Dn.Value) Then
        Dic.Add Dn.Value, Dn
    Else
        Set Dic.Item(Dn.Value) = Union(Dic.Item(Dn.Value), Dn)
    End If
Next

C = 5
    With Sheets("DTR")
        .Unprotect Password:="."
        .Range(.Range("A6"), .Range("A" & Rows.Count).End(xlUp)).Resize(, 3).ClearContents
        .Range("A5").Resize(, 3).Value = Array("DESCRIPTION", "SKU NO.", "LOCATION")
            
        If Dic.exists(.Range("A2").Value) Then
            For Each R In Dic.Item(.Range("A2").Value)
                C = C + 1
                .Range("A" & C).Resize(, 3).Value = R.Offset(, -14).Resize(, 3).Value
            Next R
        End If
    
        .Protect Password:=".", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub