VBA Code to search text string

[pjandshelly]

I am looking for a VBA code to search through 3 columns and search for a text string. In column a, I would like to search for 596Y. If it is found, I would like to create a tab for that line of data and include the header. Then for the next search, I need to look in Column B to find a list of Vendor Codes. If found, create a tab and include the header. For the final search, I would like to do a search for either the letters CO or AO and also search another column to see if it contains 23NR. For that search, it can either find CO, AO, or 23NR. Then create a tab and paste the header. This was a sample of code that I found but it only performs on one column and doesn't do a search text string.

Sub SeparateServiceVendors()
'Declaring Constant Variables
Const col = "J"
Const header_row = 1
'Assigning initial value as 2, because data transfer will happen from 2nd row onwards
Const starting_row = 2
'To declare variable of worksheet type for main sheet, that has data to split
Dim source_sheet As Worksheet
'To declare variable of worksheet type for adding required sheets
Dim destination_sheet As Worksheet
Dim source_row As Long
Dim last_row As Long
Dim destination_row As Long
'This variable is for changing values in column J, that has Service Names
Dim service As String
'Assigning Active sheet, that has data to split
Set source_sheet = ActiveSheet
'To know the last filled row and activesheet basis on column J, that has data to split
last_row = source_sheet.Cells(source_sheet.Rows.Count, col).End(xlUp).Row
For source_row = starting_row To last_row
service = source_sheet.Cells(source_row, col).Value
Set destination_sheet = Nothing
On Error Resume Next
Set destination_sheet = Worksheets(service)
On Error GoTo 0
If destination_sheet Is Nothing Then
'To add new sheet, if there is no existing sheet for the given city name
Set destination_sheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
'To assign name to added sheet
destination_sheet.Name = service
'To add header row to each added sheet
source_sheet.Rows(header_row).Copy Destination:=destination_sheet.Rows(header_row)
End If
'To identify the next available row on destination sheet
destination_row = destination_sheet.Cells(destination_sheet.Rows.Count, col).End(xlUp).Row + 1
'Copying rows from active sheet, one by one and pasting to next available line on destination sheet
source_sheet.Rows(source_row).Copy Destination:=destination_sheet.Rows(destination_row)
Next source_row
End Sub

 

[Rijnsent]

Hi Pjandshelly,
hereby some code to get you moving, hope it gives you the tools you need to get to your goal. If you bump into issues, please do post your (modified) code here and do so in the CODE brackets.
Thanks,
Koen

Sub LoopRun()

Set Sht = Worksheets("MySourceName")

FirstRow = 2
LastRow = Sht.Range("A" & Cells.Rows.Count).End(xlUp).Row

For Rw = FirstRow To LastRow
    If Sht.Range("A" & Rw).Value = "596Y" Then
        'Do something
        Debug.Print Rw
    End If
    'Or the alternative:
    If InStr(1, Sht.Range("A" & Rw).Value, "596Y") > 0 Then
        'Note: instr is case sensitive
        'Found string in Rw
    End If
Next Rw

Set Sht = Nothing

End Sub

 

[pjandshelly]

Thank you for the assistance. This helped out.