Using VBA to search over multiple sheets

[beardy]

Morning all,

I've banged my head against this problem for the last week and I'm sure I'm either inches or thousands of miles away from the solution

I have a workbook with multiple sheets and need to create a VBA script to search for one or more text strings across all the sheets - the answers may be in any of the columns on the data sheets.

I then need to return the answers (in the form of the contents of the first 4 cells in the row the string has been found in) to a different sheet within the same workbook (too many likely positive results for a message box or other userform based return system) and somewhere along the way remove any duplicate returns.

I can kinda bludgeon VBA into coughing up the whole row, but with duplicates..but can't get beyond that.

The additional complication is that the cell(s) that any 'find' function finds my search string(s) in may be in any column of the data.

I have been smart enough to make the first column of every sheet a unique key (unique to the sheet and the row on that sheet)...if that helps.

I'm running Excel 2003 (and VBA6).

Any help would be greatly appreciated - even just some good pointers for me to play with would be a good start lol

Thanks
Antony

 

[pete4monc]

@Joe Was
Hi Joe an old post but it's just been a god send and works a treat. Thanks

At the moment it searches all sheets to find a text and returns all results. Is it possible to return only results where a cell on that row does not have a date in it?
ie: Finds DSO15008 in sheet1, sheet2, sheet3 but only returns sheet1 and sheet3 because the DSO15008 on sheet2 has a date in column I (ie:job is finished)?

Thanks in advance.

 

[Excel_Fann]

Public Sub FindText()
'Run from standard module, like: Module1.
'Find all data on all sheets!
'Do not search the sheet the found data is copied to!
'List a message box with all the found data addresses, as well!
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer

myText = InputBox("Enter text to find")

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
'Do not search sheet4!
If ws.Name = "Sheet4" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address

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

Set Found = .UsedRange.FindNext(Found)

'Copy found data row to sheet4 Option!
'Found.EntireRow.Copy _
'Destination:=Worksheets("Sheet4").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
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 " & myText & " in this workbook.", vbExclamation
End If
End Sub

Very Dear Joe

It is my first time on a board like this.
Your very helpful post inspired me in a solution to a task I had.
It also inspired me to post my solution here in the hope to help others with it.

The problem I wanted to solve was the following:
Find all data on all sheets from a certain range of elements that you want to analyze one by one _
and give out the result per element on the same row/ different column in one cell.
It is a less volatile solution than yours. Instead of a message the output is written to a cell
and a solution works through a given range of elements, rather than only one element given via input box.

Again, I emphasize, that I was thinking about the problem during some days in my head, I gave it some initial tries in Excel, but with my knowledge I was not able to fully grasp it. And then I found your solution, and that was it! I just had to adapt it slightly.

Here it is and I hope it helps also others, like your solution helped to me.

Kindest Regards,
Excel_Fann


Public Sub FindText_v2ok()
'Using VBA to search over multiple sheets
'v2 adapted, ok working

'Find all data on all sheets! _
v2 = Find all data on all sheets from a certain range of elements that you want to analyze one by one _
and give out the result per element on the same row/ different column

'Do not search the sheet the found data is copied to!
'List a message box with all the found data addresses, as well!
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer


Dim rng As Range
Set rng = Range("C2:C83") 'INPUT: the range to analyse, full range = Range("C2:C83")
Dim cel As Range

For Each cel In rng.Cells

'myText = InputBox("Enter text to find")
myText = cel.Value

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
'Do not search sheet4!
If ws.Name = "Sheet4" Then GoTo myNext

Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address

Do
foundNum = foundNum + 1
AddressStr = AddressStr & "'" & .Name & "'!" & Found.Address & vbCrLf

Set Found = .UsedRange.FindNext(Found)

'Copy found data row to sheet4 Option!
'Found.EntireRow.Copy _
'Destination:=Worksheets("Sheet4").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If

myNext:
End With

Next ws

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

Else:

cel.Offset(0, 7).Value = "not used"

End If

Next cel

End Sub