The following code works to find and highlight exact matches from a set
list within a range of cells. I want it to also find matches within
cells that aren't exact matches.

This would be same as using Find with wildcards.

Example:
I would type *test* and click Find All which would return all cell that
contain "test" and also words like testing", restest, etc.

Any thoughts on how I can do this?


Sub HighlightInAandInB(ByVal Column1 As Range, _
ByVal Column2 As Range, Color As Long)
Dim Cll As Range

'Limit to the used range, to speed it up
Set Column1 = Intersect(Column1, Column1.Worksheet.UsedRange)
Set Column2 = Intersect(Column2, Column2.Worksheet.UsedRange)

'Remove the header
Set Column1 = Column1.Offset(1).Resize(Column1.Rows.Count - 1)
Set Column2 = Column2.Offset(1).Resize(Column2.Rows.Count - 1)

'Loop through the cells
For Each Cll In Column1.Cells
'Use the MATCH() function to see if the value is in there
If IsNumeric(Application.Match(Cll.Value, Column2, 1)) Then
'It is, so highlight it
Cll.Interior.Color = Color

'To delete the cell, use
'Cll.Delete Shift:=xlShiftUp
End If
Next Cll
End Sub

Sub HighlightInANotInB(ByVal Column1 As Range, _
ByVal Column2 As Range, Color As Long)
Dim Cll As Range

'Limit to the used range, to speed it up
Set Column1 = Intersect(Column1, Column1.Worksheet.UsedRange)
Set Column2 = Intersect(Column2, Column2.Worksheet.UsedRange)

'Remove the header
Set Column1 = Column1.Offset(1).Resize(Column1.Rows.Count - 1)
Set Column2 = Column2.Offset(1).Resize(Column2.Rows.Count - 1)

'Loop through the cells
For Each Cll In Column1.Cells
'Use the MATCH() function to see if the value is in there
If IsError(Application.Match(Cll.Value, Column2, 0)) Then
'Is not, so highlight it
Cll.Interior.Color = Color

'To delete the cell, use
'Cll.Delete Shift:=xlShiftUp
End If
Next Cll
End Sub

Sub UniqueList(ByVal Column1 As Range, ByVal Column2 As Range, _
RngDest As Range)
Dim WS As Worksheet

'We'll use a temporary worksheet to use Advanced Filter on it

Set WS = Workbooks.Add(xlWorksheet).Worksheets(1)

'Put the first column
WS.Range("A1").Resize(Column1.Rows.Count).Value = Column1.Value

'Put the second column, we have to skip one row, which is
'the heading
WS.Range("A1").Offset(Column1.Rows.Count).Resize( _
Column2.Rows.Count - 1).Value = Column2.Offset(1).Resize( _
Column2.Rows.Count - 1).Value

'Now, use advanced filter and put the results directly in
'the destination range

WS.Range("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=RngDest, Unique:=True

'Close the temp workbook without saving

WS.Parent.Close SaveChanges:=False
End Sub