VBA Code to search text string

pjandshelly

Board Regular
Joined
Jan 25, 2017
Messages
61
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
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
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

Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top