Match or Find Function Help Please

[mkovaleski]

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

 

[Guest]

If using Edit=>find with wildcards works, then turn on the macro recorder
while you do it manually (with the wildcards). This will give you the
initial find command. then use the sample code in the FindNext command to
see how to fine all occurances.

 

[mkovaleski]

Thanks Tom, I use that trick often however for some reason it doesn't
show the code when I record the macro.

Any other thoughts?

Matt

 

[Guest]

do you have merged cells. Do you have hidden rows or columns.

Those can cause problems - I can't think of any others.

 

[mkovaleski]

Nope, just to regular sheets nothing hidden. I've have the same thing
happen before in trying to record the visio find and replace code. It
just doesn't show for some reason.