Friday, 23 September 2016

VBA Macro to Find All exact Matches of a String in a Specific Sheet in Excel

Excel VBA Macro to Search or FindAll exact Matches of String  in a Specific Sheet and get the Address of Cell,Column and Row details of each Match
Note: Please note that the Macro will Search/Find in the Used Range of the source data.

Sub FindStrAll()
Dim Srch_Result As Range
Dim LastCell As Range
Dim MyRng As Range
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim Srch_Str As String

Set Sht = ThisWorkbook.Sheets("Results")
Set Src_Sht = ThisWorkbook.Sheets("Data")
    
    Src_Sht.Activate
    Src_Sht.Cells.Select
    
Set LastCell = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
Set MyRng = Src_Sht.Range("$A$1:" & LastCell.Address)

 X = 2
 Y = 2
 Z = 0

 Do Until Sht.Range("A" & Y).Value = ""
    Srch_Str = Sht.Range("A" & Y).Value
    Str_Cnt = Application.WorksheetFunction.CountIf(MyRng, Srch_Str)

'Set Srch_Result = Selection.Find(What:=Srch_Str, After:=LastCell)
 Set Srch_Result = Selection.Find(What:=Srch_Str, After:=LastCell, _
                    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    If Srch_Result Is Nothing Then
        MsgBox "Search Item Not Found in Source Data", vbOKOnly, "Search Completed"
    Else

        Do While Not Srch_Result Is Nothing
           Srch_Result.Activate 'Activating the search result in source data sheet
           Z = Z + 1
               Sht.Range("A" & X).Offset(0, 1).Value = ActiveCell.Value
               Sht.Range("A" & X).Offset(0, 2).Value = ActiveCell.Address
               Sht.Range("A" & X).Offset(0, 3).Value = Cells(1, ActiveCell.Column).Value
               Sht.Range("A" & X).Offset(0, 4).Value = ActiveCell.Column
               Sht.Range("A" & X).Offset(0, 5).Value = ActiveCell.Row
           Set Srch_Result = Selection.FindNext(After:=ActiveCell)
           
           X = X + 1
           If Z = Str_Cnt Then Exit Do
        Loop

        Z = 0    
    End If

    Y = Y + 1   'Increment of Search Strings range variable
  Loop

Sht.Activate
Sht.Range("A1").Select

Set Srch_Result = Nothing
Set Sht = Nothing
Set Src_Sht = Nothing
Set LastCell = Nothing
Set MyRng = Nothing

End Sub
-----------------------------------------------------------------------------------------------------------------------
Example: 
Suppose the we have the Source data as follows where we want to search/find a string as follows:

The Output of the Macro is as follows:

Thanks,
TAMATAM

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts