How do to search for a string in excel across all rows/columns and save the result?

Hi,
I have a text file which i will import into xls.
Once imported i am only interested in rows that have specific keywords in any
of its columns.

How to search for a string let us say 'HONDA' in the entire xls(across all columns and rows) and save only those rows containing the searched string, to a separate xls file?

I have 5 to 10 keywords to search.

I want the +ve result of all the above searches to be saved to a different xls.

How can i do this?

Thanks a lot. I am new to excel VBA.

Regards,
akondeti

akondeti

Try this macro
You will need to change the saveas drive and path location

Sub FindEntries()
Dim wB As Workbook
Dim wsS As Worksheet
Dim wsP As Worksheet
Dim Rng As Range

Dim lLastUsedRow As Long
Dim iLastUsedColumn As Integer

Dim lRow As Long
Dim lPasteRow As Long
Dim sFind As String

sFind = InputBox("Search For?")
If sFind = "" Then
Exit Sub
End If
Set wsS = ActiveSheet

lLastUsedRow = wsS.Cells.Find(what:="*", searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
iLastUsedColumn = wsS.Cells.Find(what:="*", searchorder:=xlByColumns, _
searchdirection:=xlPrevious).Column

Set wB = Workbooks.Add
Set wsP = wB.Sheets(1)

Set Rng = wsS.Cells(lLastUsedRow, iLastUsedColumn)
Do

Set Rng = wsS.Cells.Find(what:=sFind, After:=Rng, LookIn:=xlFormulas, LookAt _
:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Rng Is Nothing Then
Exit Do
End If
If Rng.Row > lRow Then
lPasteRow = lPasteRow + 1
wsS.Rows(Rng.Row).Copy Destination:=wsP.Rows(lPasteRow)
lRow = Rng.Row
End If
Loop Until Rng.Row < lRow
wsP.Name = "Honda"
Application.DisplayAlerts = False
wB.SaveAs Filename:="C:\" & sFind & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
End Sub

Mudraker,

WOW!!
It worked.

I request little more help from you.
(a)In your macro we are searching for only for one string 'HONDA'. But i have 5 to 10 strings that i have to search for? Also these strings are almost same all the time. So instead of inputting each time, we can hardcode them in the macro itself. Please guide me how to change your macro to accommodate this.

(b)Apart from this couple of other VBA basic questions( i am new to VBA)
If i want 90 days prior date to today i.e Today-90 days in MM/DD/YYYY format, which i will later use in the FIND string, how to get date into a variable?

(c)Using autofilter, how to refer to the column name rather than the field number for example, the following works.

Selection.AutoFilter Field:=27, Criteria1:="=BB-LL", Operator:=xlAnd
How to replace Field:=27 with Field name=rec code ?

(d)Using autofilter how can i specify more than 2 Criterias for a Field?
If i have 10 different criteria's for a field, can i create Criteria1 thru Criterial10?

Again thanks for your help.

Regards,
akondeti

Question Part A answer

Sub FindEntries()
Dim wB As Workbook
Dim wsS As Worksheet
Dim wsP As Worksheet
Dim Rng As Range

Dim iFor As Integer
Dim iLastUsedColumn As Integer

Dim lLastUsedRow As Long
Dim lRow As Long
Dim lPasteRow As Long

Dim sFind As String
Dim sSearch(1 To 10) As String ' adjust last number as required

sSearch(1) = "Honda"
sSearch(2) = "Ford"
sSearch(3) = "Toyota"


For iFor = LBound(sSearch) To UBound(sSearch) Step 1
sFind = Issearch(iFor)
If sFind = "" Then
Exit Sub
End If
Set wsS = ActiveSheet

lLastUsedRow = wsS.Cells.Find(what:="*", searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
iLastUsedColumn = wsS.Cells.Find(what:="*", searchorder:=xlByColumns, _
searchdirection:=xlPrevious).Column

Set wB = Workbooks.Add
Set wsP = wB.Sheets(1)

Set Rng = wsS.Cells(lLastUsedRow, iLastUsedColumn)
Do

Set Rng = wsS.Cells.Find(what:=sFind, After:=Rng, LookIn:=xlFormulas, LookAt _
:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Rng Is Nothing Then
Exit Do
End If
If Rng.Row > lRow Then
lPasteRow = lPasteRow + 1
wsS.Rows(Rng.Row).Copy Destination:=wsP.Rows(lPasteRow)
lRow = Rng.Row
End If
Loop Until Rng.Row < lRow
wsP.Name = "Honda"
Application.DisplayAlerts = False
wB.SaveAs Filename:="C:\" & sFind & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
Next iFor
End Sub

Question Part B Answer
Dim dDate As Date
dDate = Now() - 90

or

Dim sDate As String
sdate = format(now()-90,"mm/dd/yyyy")


Question Part C Answer
As far as I know you cannot change the Field Number with a name unless it is a named cell/range which would still have to be supplied to the code as a number

example
In this example if the NamedArea range covers cells in more than 1 column then the lowest column number will be used

Selection.AutoFilter Field:=Range("NamedArea").Column, Criteria1:="=BB-LL", Operator:=xlAnd.



Question Part D Answer
As far as I know you can't set more than 2 Criterias

Mudraker,
Thanks for all your help. Sorry it took some time for me to get back to you.
Your code did worked well(no surprise). However for my specific situation, i tried to tune the macro and tested it. I encountered problems when there is just one row and when there are multiple rows with multiple matches across columns.
Here is my code (not very decent but works. It is just a revised version of your code. Thanks again)

Sub FindEntries()
Dim wB As Workbook
Dim wsS As Worksheet
Dim wsP As Worksheet
Dim Rng As Range

Dim iFor As Integer
Dim iFor1 As Integer
Dim tLoop As Integer

Dim iLastUsedColumn As Integer
Dim lLastUsedRow As Long

Dim lRow As Long
Dim lCol As Long
Dim pRow As Long
Dim lPasteRow As Long

Dim sFind As String
Dim sSearch(1 To 10) As String ' adjust last number as required
Dim sRow(1 To 1000) As Long


sSearch(1) = "Honda"
sSearch(2) = "Ford"
sSearch(3) = "Toyota"

Set wsS = ActiveSheet
Set wB = Workbooks.Add
Set wsP = wB.Sheets(1)

For iFor = LBound(sSearch) To UBound(sSearch) Step 1
sFind = sSearch(iFor)
If sFind = "" Then
Exit For
End If


lLastUsedRow = wsS.Cells.Find(what:="*", searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
iLastUsedColumn = wsS.Cells.Find(what:="*", searchorder:=xlByColumns, _
searchdirection:=xlPrevious).Column


Set Rng = wsS.Cells(lLastUsedRow, iLastUsedColumn)
Do

Set Rng = wsS.Cells.Find(what:=sFind, After:=Rng, LookIn:=xlFormulas, LookAt _
:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

If Rng Is Nothing Then
Exit Do
End If

If Rng.Row > lRow Then

'Check to see if the row is already stored
sStored = False

For iFor1 = LBound(sRow) To lPasteRow Step 1
If Rng.Row = sRow(iFor1) Then
sStored = True
Exit For
End If
Next iFor1

If Not sStored Then
lPasteRow = lPasteRow + 1
wsS.Rows(Rng.Row).Copy Destination:=wsP.Rows(lPasteRow)
lRow = Rng.Row
sRow(lPasteRow) = Rng.Row
End If
tLoop = tLoop + 1 'This is used to terminate the loop
End If

'This is used to terminate the loop
iLoop = False
If Rng.Row = pRow And Rng.Column <= iCol Then iLoop = True
pRow = Rng.Row
iCol = Rng.Column

Loop Until Rng.Row < lRow Or tLoop > lLastUsedRow Or iLoop
lRow = 0
pRow = 0
iCol = 0


Next iFor
wsP.Name = "Honda"
Application.DisplayAlerts = False
wB.SaveAs Filename:="C:\Adi\Adi\Filter-file.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

End Sub

Let me take this oppurtunity to learn from you.
(a)in a DO loop or FOR loop, how to immediately comeout and go to the beginning of next execution?
When i exit the DO or FOR loop(Exit For) it comes out but will go thru the rest of the code before starting the next iteration.

(b)If i am in a nested loop(FOR or DO) how to go to the beignning of outermost loop from innermost? Any options like using labels and ESCAPE TOP as we have on Mainframe code?

(c)For current code to work, i have to open the excel and then copy the macro code into it and then run it. How to change this code so that I can save this macro on my desktop and on double clicking it will ask me the file name to act on?

Thanks again for all your help.

Regards,
Adi

akondeti

You can use Goto to jump to a certain part of your code. Many consider this bad programming.



Sub fffg()
Dim iFor As Integer
JumpToStart:
For iFor = 1 To 10 Step 1
If iFor = 8 Then
JumpToExit
End If
JumpToExit:
End Sub


In your code I have changed the names of some of your variables to reflect the type they are and declared a couple that you did not have declared
eg. sStored changed to bStored - b for Boolan,

I suggest that under VB Editor you goto Tools < Options > Editor Tab and tick the Require Variable Declaration. This will ensure that you have to decalre all variables, this ensures that they are declared as the type required and you reduce errors due to mistyped variable names.

If you do turn this option on then the 1st line of all new modules will be
Option Explicit
You will need to add this to any existing modules


Have added code to get a excel file name and then open that file - have also put a disabled line of code on how to get a text file name

Looking at your code I was not sure which loops you are trying to break out of and go back to main iFor loop

This is your code modified to meet some of your requirements
Option Explicit

Sub FindEntries()
Dim wbD As Workbook
Dim wbN As Workbook
Dim wsS As Worksheet
Dim wsP As Worksheet

Dim Rng As Range

Dim bStored As Boolean
Dim bLoop As Boolean

Dim iCol As Integer
Dim iFor As Integer
Dim iFor1 As Integer
Dim iloop As Integer

Dim iLastUsedColumn As Integer
Dim lLastUsedRow As Long

Dim lrow As Long
Dim lCol As Long
Dim lpRow As Long
Dim lPasteRow As Long
Dim lsRow(1 To 1000) As Long

Dim sFind As String
Dim sSearch(1 To 10) As String ' adjust last number as required
Dim sFile As String

'sFile$ = Application.GetOpenFilename("Text Files (*.txt), *.txt")

sFile$ = Application.GetOpenFilename("Excel_Files (*.xls), *.xls")

If sFile = "False" Then
Exit Sub
End If


sSearch(1) = "Honda"
sSearch(2) = "Ford"
sSearch(3) = "Toyota"

Workbooks.Open Filename:=sFile
Set wbD = ActiveWorkbook
Set wsS = ActiveSheet
Set wbN = Workbooks.Add
Set wsP = wbN.Sheets(1)

For iFor = LBound(sSearch) To UBound(sSearch) Step 1
If sSearch(iFor) = "" Then
Exit For
End If

lLastUsedRow = wsS.Cells.Find(what:="*", searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
iLastUsedColumn = wsS.Cells.Find(what:="*", searchorder:=xlByColumns, _
searchdirection:=xlPrevious).Column


Set Rng = wsS.Cells(lLastUsedRow, iLastUsedColumn)
Do

Set Rng = wsS.Cells.Find(what:=sFind, After:=Rng, LookIn:=xlFormulas, LookAt _
:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)

If Rng Is Nothing Then
Exit Do
End If

If Rng.Row > lrow Then

'Check to see if the row is already stored
bStored = False

For iFor1 = LBound(lsRow) To lPasteRow Step 1
If Rng.Row = lsRow(iFor1) Then
bStored = True
Exit For
End If
Next iFor1

If Not bStored Then
lPasteRow = lPasteRow + 1
wsS.Rows(Rng.Row).Copy Destination:=wsP.Rows(lPasteRow)
lrow = Rng.Row
lsRow(lPasteRow) = Rng.Row
End If
iloop = iloop + 1 'This is used to terminate the loop
End If

'This is used to terminate the loop
bLoop = False
If Rng.Row = lpRow And Rng.Column <= iCol Then bLoop = True
lpRow = Rng.Row
iCol = Rng.Column

Loop Until Rng.Row < lrow Or iloop > lLastUsedRow Or bLoop
lrow = 0
lpRow = 0
iCol = 0

' wsP.Name = sSearch(iFor)

Next iFor
'some of these codes may need to move into the for next (ifor) loop
wsP.Name = "Honda"
Application.DisplayAlerts = False
wbN.SaveAs Filename:="C:\Adi\Adi\Filter-file.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True

End Sub