Find text

[colinharwood]

Hi All

I have a workbook which contains 12 sheets, is it possible write a macro which will search for a text string which could be on any of the 12 sheets

Thanks a lot

colin

 

[Joe Was]

You will need to add a counter and then test the counter to take the right action.

m = m + 1

If m > 10 Then

MsgBox "Too many found, refine your search!"

Else

'The code to post the found data
End If

 

[itsme2]

Okay now I am stuck in this increcible loop and cannot even do a CTL Break to escape..

Be back in a sec... had to kill the Excel Process and lost what I had for code but I pretty certain if I add an exit sub after that it might have worked

 

[itsme2]

I'm back

I am about to try this wish me luck lol

Sub FindTextFromCell()
'Run from standard module, like: Module1.

Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer

myText = Sheets("Sheet2").Range("A1").Value

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
m = m + 1

If m > 10 Then

MsgBox "Too many found, refine your search!"
' Exit Sub
Else

If .Name = "Sheet2" Then GoTo myNext
If .Name <> "Sheet2" Then _
Found.EntireRow.Copy _
Destination:=Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With

myNext:
Next ws
End Sub

At least if I have shut down Excel I'll have this somewhere

 

[marquiskissel]

I am reviving this ever so popular thread! I have made just a few modifications to your code so that it gives me the address. THe problem is that it seems to repeat values and not get all of them and it also does not give the sheet name in the address. One other question, what do I need to do if I want it to only search in range a1:f20 on one sheet and g5:j30 on all the other sheets? If you can just get me started on the range part that would be great. I appreciate all your help!

Public Sub FindTextFromCell()
'Run from standard module, like: Module1.

Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer

myText = "--"

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do

If .Name = "Sheet2" Then GoTo myNext
If .Name <> "Sheet2" Then _
Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0) = FirstAddress

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With

myNext:
Next ws
End Sub

 

[Joe Was]

I did not test this!


Public Sub FindTextFromCell()
'Run from standard module, like: Module1.

Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer

myText = "--"

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do

If .Name = "Sheet2" Then GoTo myNext

If Application.Union(Range(FirstAddress), Range("G5:J30")) = True Then
If .Name <> "Sheet2" Then _
Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0) = ws.Name

Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 1) = FirstAddress

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End If
End With

myNext:
Next ws
End Sub

 

[itsme2]

It's still returning hundreds of results... what am I doing wrong?

Sub FindTextFromCell()
'Run from standard module, like: Module1.

Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer
m = m + 1
Range("A2:G2").ClearContents
myText = Sheets("Sheet2").Range("A1").Value

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
If .Name = "Sheet2" Then GoTo myNext
If .Name <> "Sheet2" Then _
Found.EntireRow.Copy _
Destination:=Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress

End If
End With

myNext:
Next ws

If m > 10 Then

MsgBox "Too many found, refine your search!"
Exit Sub
End If
End Sub

 

[Joe Was]

This will add the found counter and over 10 found utility [Msg & Remove currently found on Sheet2 log]!


Sub FindTextFromCell()
'Run from standard module, like: Module1.

Dim ws As Worksheet
Dim Found As Range
Dim myText As String, FirstAddress As String, thisLoc As String, rngNm As String
Dim AddressStr As String
Dim foundNum As Integer
Dim my1st As Long

Range("A2:G2").ClearContents
myText = Sheets("Sheet2").Range("A1").Value

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do

If .Name = "Sheet2" Then GoTo myNext

If .Name <> "Sheet2" Then m = m + 1

If .Name <> "Sheet2" Then _
Found.EntireRow.Copy _
Destination:=Worksheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)

If m = 1 Then my1st = Worksheets("Sheet2").Range("A65536").End(xlUp).Row

'Worksheets("Sheet2").Range("A65536").End(xlUp).Value = .Name

If m >= 10 Then
MsgBox "Too many found [ " & m & " ], refine your search!"

Worksheets("Sheet2").Range("A" & my1st & ":A" & _
Worksheets("Sheet2").Range("A65536").End(xlUp).Row).EntireRow.Delete
Exit Sub
End If

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress

End If
End With

myNext:
Next ws
End Sub

 

[caspermurphy]

more on this

I am now trying to use the following code in another workbook.

by the way using windows 2000, office 2003

workbook has 6 sheets, name, name2...name6 they all have the same format, date being in the second for a calendar quarter. When I search for the current date or later it works fine, however if I search foran older date it states it does not find it. Now i use this code in another workbook and it work just fine. but not in this one. any ideas?
thank you in advance.

Public Sub FindText1()
'Run from standard module, like: Module1.

Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer
Dim mytextdate As String

'myText = InputBox("Enter text to find")

Sheets("daily report").Select
Range("a1").Select
myText = ActiveCell.Value
Selection.ClearContents
Range("a2").Select
'ActiveCell.NumberFormat = "mm/dd/yyyy"

mytextdate = ActiveCell.Value



'MsgBox "find " & myText & " in this workbook.", vbExclamation
'testing purposes only

If myText = "" Then Exit Sub


For Each ws In ThisWorkbook.Worksheets
With ws


Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=True)

If Not Found Is Nothing Then
FirstAddress = Found.Address

Do
foundNum = foundNum + 1
rngNm = .Name
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
thisLoc = rngNm & " " & Found.Address

Sheets(rngNm).Select
Range(Found.Address(RowAbsolute:=False, _
ColumnAbsolute:=True)).Select

'myFind = MsgBox("Found one """ & myText & """ here!" & vbCr & vbCr & _
thisLoc, vbInformation + vbOKCancel + vbDefaultButton1, "Your Result!")
SendKeys ("{down 1}")

If myFind = 2 Then Exit Sub

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
'Loop While (Not Found Is Nothing And Found.Column = 4) <> FirstAddress

End If
End With

Next ws

If Len(AddressStr) Then
'MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"

Else:

MsgBox "Unable to find " & mytextdate & " in this workbook.", vbExclamation

End If

End Sub

 

[owendodd]

Hi iwas wondering if anyone was still viewing this post. I am currently trying to retrieve info from different workbooks. I have one or two things left to do to finish it. It has been of great help to me.

I am currently trying to find refine my search to column A in the workbook but am not having much look with it.

Also i sometimes in my search i have to enter in codes like AD-003 and then 003. It does find the exact match for AD-003 but does not find the exact match for 003.

Here is my code

Sub Search()
'Standard Module code, like: Module1!
Dim f%, foundNum%
Dim ws As Worksheet
Dim Found As Range
Dim myText$, FirstAddress$, thisLoc$, rngNm$, AddressStr$


myText = ActiveSheet.Range("B5").Value

If myText = "" Then Exit Sub

Application.ScreenUpdating = False

With Application.FileSearch
.NewSearch

'Option: Search Sub-Folders as well?
.SearchSubFolders = False 'Option: True or False!

'Option Current Folder or a defined folder?
'.LookIn = CurDir
'Or
.LookIn = "S:\Document\Database"


'Option: Only Search this type of file?
.Filename = "QS Level III Database.xls"

'Workbooks.Open Filename:="S:\Document\Data_00.xls", ReadOnly:=True

.Execute

For f = 1 To .FoundFiles.Count
Set Wb = Workbooks.Open(Filename:=.FoundFiles(f), ReadOnly:=True)

For Each ws In Wb.Worksheets

With ws

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, MatchCase:=False)
If Not Found Is Nothing Then
FirstAddress = Found.Address
CodeStr = Found.Offset(, 1).Value & " refering to the worldwide standards " & Found.Offset(, 2).Value
If Len(CodeStr) = 0 Then CodeStr = "blank."
Do
foundNum = foundNum + 1
rngNm = .Name
AddressStr = AddressStr & .Name & " " & " Document Name is " & CodeStr & vbCrLf
thisLoc = rngNm & " " & Found.Address
'ActiveSheet.Select
Sheets(rngNm).Select
Range(Found.Address(RowAbsolute:=False, _
ColumnAbsolute:=False)).Select
If myFind = 1 Then Exit Sub

Set Found = .UsedRange.FindNext(Found)
CodeStr = Found.Offset(, 1).Value & Found.Offset(, 2).Value


Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With
Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " time(s)." & vbCr & _
AddressStr, vbOKOnly, myText & " has been found"
Else:
MsgBox "Unable to find " & myText & " in Workbook: " & Wb.Name, vbExclamation
End If

ActiveWorkbook.Close

Next f
End With

Application.ScreenUpdating = True
End Sub

 

[Joe Was]

To get it to search for part of the string in another string you need to set the property.

lookAt:=xlPart

in the Search string!