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
Bookmarks