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

 

[David12345]

Aha, sussed it - there are a couple of colons in the code which need to be taken out.
However what I would really like to do I suppose is to have the results appear in a list box so that I can then select which one I want to use.
When selected, I would like the info on the relevant row to appear ideally in a user form so that I can format it in a useable way, and can print it.
Am I expecting too much of Excel?
Any ideas gratefully received.

 

[caroleo]

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

Joe Was,

What a great Macro; and it almost solves a big problem for me. The trouble I am having is that it requires me to enter a search string. I would like it to search through a specific column of data in all sheets and find all unique values and set them as the search string. For example, column C in each worksheet contains the number or name of a specific delivery vehicle; most of which are used many times over in each of 4 sheets. I want to pull together all deliveries made by these vehicles (the selection of the row of data including the vehicle number in Column C of each worksheet works great) into the sheet searching on that vehicle number or name. But I need a complete list of all deliveries made by all vehicles without having to input the number or name of each vehicle individually. If you can help, I will be very grateful.

 

[Kentman]

Joe's code is great and has helped out a lot but......there's always a but!

Instead of returning the text, I would like to be able to return the sheet name and cell address so that I can refer to it using the INDIRECT function - anyone give me a pointer?

 

[Philip1957]

Greetings,

I found this old posting of yours and was wondering about a couple of things.

I don't need to copy & paste the found strings so I left it comment blocked but I do have a sheet to exclude from the search so I changed the shhet number to ignore.

The results box gives the correct results but the macro doesn't stop running until I click the "OK" button.

Also, is there a way to make the listings in the results box hyperlink to the location in the workbook?

I'm running Excel 2013

 

[MikeLewis]

The sub below assumes that you have at least 6 worksheets and that they are named 'Sheet1', 'Sheet2', etc...
Public Sub tryit()
Dim Rng As Range
Dim TextToFind As String

Do
TextToFind = InputBox("Enter Text To Find")
If TextToFind = "" Then Exit Do
Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6")).Select
Set Rng = Cells.Find(TextToFind)
If Rng Is Nothing Then
Call MsgBox("Text Not Found!", vbCritical, "Text Not Found")
Else
Call MsgBox("Text Found in sheet:" + Rng.Worksheet.Name, vbInformation, "Found")
End If
Loop

End Sub

 

[MikeLewis]

After further testing, this does not work!

 

[Philip1957]

Mr. Lewis,

Thanks for looking.

I'm currently trying to work the bugs out of this code, which I found on the internet. It uses a module and a form

Module:

Sub DisplayModalUserForm1()
  'Modal    UserForm locks out all Excel Access (vbModal)
  'Modeless UserForm allows access to Excel Resources while UserForm is active (vbModeless)
  UserForm1.Show vbModal
End Sub

Sub DisplayModelessUserForm1()
  'Modal    UserForm locks out all Excel Access (vbModal)
  'Modeless UserForm allows access to Excel Resources while UserForm is active (vbModeless)
  UserForm1.Show vbModeless
End Sub

Public Function SearchAndDisplayResultsInUserForm1ListBox1()
  'Search all worksheets and output a message box with all the found data addresses
  '
  'The ListBox Column Assignments (First Column is Column 0):
  '0 = 'Sheet'
  '1 = Sheet Name
  '2 = 'Cell'
  '3 = Cell Address
  '
  'NOTE: This is a function to remove it from the List of Macros that can be called directly from Excel (ALT F8)
  
  Dim ws As Worksheet
  
  Dim r As Range
  
  Dim iFoundCount As Long
  Dim iListBoxRow As Long
  
  Dim bProcessThisSheet As Boolean
  Dim bExactMatchRequired As Boolean
  
  Dim sAddress As String
  Dim sMatchTypeRequired As String
  Dim sSheetName As String
  Dim sSearchString As String
  Dim sFirstAddress As String
  Dim sConcatenation As String
  Dim sMessage As String

  'Get the 'Search String' from the UserForm (with leading/trailing spaces removed)
  sSearchString = Trim(UserForm1.TextBox1.Value)

  'Clear the contents of the ListBox
  UserForm1.ListBox1.Clear
  
  'Determine if an Exact Match is required or if a Partial Match is OK
  bExactMatchRequired = UserForm1.OptionButtonExactMatch.Value
  
  'Initialize the ListBox Row Number
  iListBoxRow = -1
  
  'Exit if the Search String is BLANK
  If Len(sSearchString) = 0 Then
    Exit Function
  End If

  'Search each Sheet in the Workbook (unless the sheet is to be IGNORED)
  For Each ws In ThisWorkbook.Worksheets
  
    'Get the Current Sheet Name
    sSheetName = ws.Name
    
    'Determine if this Sheet is to be Processed
    Select Case sSheetName
    
      Case "Navigation Instructions"
        bProcessThisSheet = False
      
      Case Else
        bProcessThisSheet = True
    
    End Select
    
    
    If bProcessThisSheet = True Then
    
      'Find the first match on the Sheet
      If bExactMatchRequired = True Then
        sMatchTypeRequired = " (COMPLETE EXACT Match Required)"
        Set r = ws.UsedRange.Find(what:=sSearchString, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
      Else
        sMatchTypeRequired = " (Partial Match Acceptable)"
        Set r = ws.UsedRange.Find(what:=sSearchString, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
      End If

      'Continue processing only if the First Match was found
      If Not r Is Nothing Then
        sFirstAddress = r.Address(False, False) '(False, False) removes BOTH '$ signs from the address
        sAddress = sFirstAddress

        Do
          'Increment the 'Found' Count
          iFoundCount = iFoundCount + 1
          
          'Increment the ListBox row number
          iListBoxRow = iListBoxRow + 1
    
          'Add the next row to the ListBox
          UserForm1.ListBox1.AddItem
          UserForm1.ListBox1.List(iListBoxRow, 0) = "Sheet"
          UserForm1.ListBox1.List(iListBoxRow, 1) = sSheetName
          UserForm1.ListBox1.List(iListBoxRow, 2) = "Cell"
          UserForm1.ListBox1.List(iListBoxRow, 3) = sAddress
          
          'Look for the 'Next' Match
          'Exit if there is NO MATCH (should never occur) or when the First Address repeats
          Set r = ws.UsedRange.FindNext(r)
          sAddress = r.Address(False, False)
    
        Loop While Not r Is Nothing And sAddress <> sFirstAddress
        
      End If
    
    End If

  Next ws

  'Display a message in the UserForm Status Label
  If iFoundCount = 0 Then
    sMessage = "Unable to find " & sSearchString & " in this workbook" & sMatchTypeRequired & "." & vbCrLf & _
               "To search AGAIN, Put text to find in the 'TextBox' and select 'Search'."""
  Else
    sMessage = "Found '" & sSearchString & "' " & iFoundCount & " times" & sMatchTypeRequired & "." & vbCrLf & _
               "'Double Click' a line in the 'ListBox' to go to that Cell, or " & vbCrLf & _
               "To search AGAIN, Put text to find in the 'TextBox' and Select 'Search'."
  
  End If
  UserForm1.LabelStatus.Caption = sMessage
  
End Function

Here's the Form:

Option Explicit

Private Sub UserForm_Initialize()
    Dim LabelStatus As Object
    Dim TextBox1 As Object
    Dim OptionButtonExactMatch As Object
    Dim OptionButtonPartialMatch As Object
    Dim ListBox1 As Object
    
    
  With LabelStatus
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
 
    .ForeColor = vbBlue                'Font Color
    .Caption = "Put text to find in the 'TextBox' and select 'Search'."
  End With

  With TextBox1
    .Font.Name = "Arial"
    .Font.Size = 12
    .Font.Bold = True
 
    .ForeColor = vbBlue                'Font Color
  End With

  With OptionButtonExactMatch
    .Font.Name = "Arial"
    .Font.Size = 8
    .Font.Bold = True
 
    .ForeColor = vbBlack               'Font Color
  End With

  With OptionButtonPartialMatch
    .Font.Name = "Arial"
    .Font.Size = 8
    .Font.Bold = True
 
    .ForeColor = vbBlack               'Font Color
  End With

  With ListBox1
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
 
    .ForeColor = vbBlack
  End With
  
  'Initialize the 'TextBox' Tag value
  TextBox1.Tag = ""

End Sub

Private Sub TextBox1_Change()
  'This processes CHANGES in TextBox1
  
  Dim sValue As String
  
  'Get the TextBox value (with leading/trailing spaces removed)
  sValue = Trim(TextBox1.Value)

  'Make the 'Search' CommandButton Visible only if the TextBox value has changed.
  If sValue = TextBox1.Tag Then
    CommandButtonSearch.Visible = False
  Else
    CommandButtonSearch.Visible = True
  End If

End Sub

Private Sub CommandButtonSearch_Click()
  'This searches for matches to the value in TextBox1 and puts the results in 'ListBox1'
  Call SearchAndDisplayResultsInUserForm1ListBox1
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  'This puts the focus on the 'Sheet' and 'Cell' that are on the line that was 'Double Clicked'

  Dim iListBoxRow As Long
  Dim sCellAddress As String
  Dim sSheetName As String
  
  'Get the ListBox Row selected
  'Get the 'Sheet Name' and the 'Cell Address'
  iListBoxRow = UserForm1.ListBox1.ListIndex
  sSheetName = UserForm1.ListBox1.List(iListBoxRow, 1)
  sCellAddress = UserForm1.ListBox1.List(iListBoxRow, 3)
  
  'Put the focus on the 'Sheet' and 'Cell Address' selected
  ThisWorkbook.Sheets(sSheetName).Select
  ThisWorkbook.Sheets(sSheetName).Range(sCellAddress).Select
  
  'Close the UserForm
  Unload Me
  
End Sub

At first the form was hanging and the error said the variables were undefined, so I added all of the variable definitions at the top, one for each variable used with the "with" statement.

Now it hangs in the module itself at the

UserForm1.Show vbModal

statement with an error message "Object Variable or With block variable not set." The same results when I try to run it Modeless.

I assume the error message is refereing the to variables on the form even though the error is generated from the module because when I open the form in the VBA editor all I see is the generic blank form, although if I hit F7 the code I pasted in is there. I don't understand what I am supposed to set the variables to! The error message doesn't specify which With statement is causing the issue and some of the variables won't have a value until I enter the search text into the boxes.

 

[master_crazy]

Sub findAllRangeDat()

Dear Joe, incase I've sheet
with sheet1:

Nr.	Products	Class	Price
1	Product 1	A1	?
2	Product 1	B1	?
3	Product 1	C1	?
4	Product 1	D1	?
5	Product 2	A2	?
6	Product 2	B2	?
7	Product 2	C2	?
8	Product 2	D2	?

<colgroup><col><col><col span="2"></colgroup><tbody>
</tbody>

and sheet2:

Nr.	Products	Class	Price
1	Product 1	A1	100
2	Product 1	B1	200
3	Product 1	C1	300
4	Product 1	D1	400
5	Product 2	A2	150
6	Product 2	B2	250
7	Product 2	C2	350
8	Product 2	D2	450

<colgroup><col><col><col span="2"></colgroup><tbody>
</tbody>

I want lookup with: ( Sheet1.Product(i) MATCH Sheet2.Product(i) ) AND (Sheet1.Class(j) MATCH Sheet2.Class(j)) when i=j then Return value Sheet2.Price(i) to Sheet1.Price(i).

What code for this situation?
Please help!

 

[LEG_END]

Joe Was, your code works great for me but how would I select and then copy and paste the complete rows into a desired sheet?

 

[sleek12]

Old thread, but Thanks for that solution @Joe Was , i was searching for that solution for over a week.