Find a word in a cell and delete the rows which doesn't have the word

[rider]

I am working on a report where in i have 93K+ line items which has multiple data in one cell. It is pulled from another system, so i cannot split the data into different columns, i need to keep the current formatting. I also have 6K+ line items, which is only a part of data in the first file.
Eg: File 1, i have data as "12347AB 123ABCDEFGHIJKLMNOP AB12 AB1234" (all these are in one single cell with proper spacing), and in file 2 i have only "12347AB".
So i need to create a code where in i can search for "12347AB" in the file 1, and delete the lines which dont have that data.....
Or at the least change color of the cell which has the data....
Could any one help me please....

[Yongle]

Hi Rider

Can you please confirm that you want to delete all rows in file 1 where
the first 7 characters in column A of any row in FILE1 do not equal the contents of any cell in column A of FILE2

Yon

[Yongle]

Hi Rider
Try this
It works by grabing the first 7 charcaters of each cell in file1 and utilising VLookup to search for those values in file2. If it fails to find a match, then that row in file1 is deleted, otherwise left untouched.
(The table for the VLookup array is column A in file 2)
You will need to alter the file names, file paths and sheet names to match yours.
Also - I have assumed that your data is held in column A in both files, and the row count is also based on column A
Good luck and would welcome feedback.
Yon

Sub Match_String()
'open the 2 files
Workbooks.Open Filename:="C:\?\?\File01.xlsx" '<your file name and path
Workbooks.Open Filename:="C:\?\?\File02.xlsx" '<your file name and path
'set up variables
Dim RngFile1 As Range, RngFile2 As Range
Dim str1 As String, str2 As String
Dim LastRowsFile1 As Long, LastRowsFile2 As Long


'determine data range in file1
Windows("File01.xlsx").Activate '<your file name
Sheets("Sheet1").Select '<your sheet name
LastRowsFile1 = Cells(Rows.Count, 1).End(xlUp).Row
Set RngFile1 = Range("A2:A" & LastRowsFile1)
'determine range to check values against in file 2
Windows("File02.xlsx").Activate '<your file name
Sheets("Sheet1").Select '<your sheet name
LastRowsFile2 = Cells(Rows.Count, 1).End(xlUp).Row
Set RngFile2 = Range("A2:A" & LastRowsFile2)


On Error Resume Next 'VLookup can be sulky and throw errors if it does not find a match


'step through values in column A (of file1), comparing the leftmost 7 characters _
against each value in column A (of file2) using VLookup


Windows("File01.xlsx").Activate '<your file name
Sheets("Sheet1").Select
For c = LastRowsFile1 To 2 Step -1 'stop at row 2 to avoid deleting header
str2 = blank
str1 = Left(Cells(c, 1), 7)
str2 = Application.WorksheetFunction.VLookup(str1, RngFile2, 1)
If str1 <> str2 Then
'delete this row if no match for the value in file 1
Rows(c).EntireRow.Delete
Else
' do not delete this row
End If
Next c


End Sub

[jolivanes]

wb2 is the workbook name of what you call file 2 and that this workbook is open.
It assumes that the value (in your example 12347AB) is in cell A1 of wb2.
It also assumes that the sheets are named "Sheet1" in both workbooks.
I did a very limited test but you better do a comprehensive test in a copy of your workbook.



Sub With_AutoFilter()
Dim a As String
Dim wb2 As Workbook
Set wb2 = Workbooks("TempBook.xlsm") '<-----Change Workbook Name
a = wb2.Sheets("Sheet1").Range("A1").Value '<-----Change Cell Reference
With Sheets("Sheet1").Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
.AutoFilter 1, "<>*" & a & "*"
End With
Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(12).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
End Sub

[jolivanes]

Re: Post #1 "Could any one help me please...."

Did anybody help you?