Excel VBA search multiple sheets

[jonobono8888]

Hi All,

I have this workbook which contains one summary page and numerous other worksheets which have rows containing different restricted substances according to regulations. Each of these substances have different identification numbers (CAS), EC Numbers and Regulations which are labelled as separate columns. (i.e. Col A = Substance, Col B = CAS, Col C = EC #, etc). Note: Not all worksheets has the same info – so some may have extra data like description, websites where you can find it, some may have less (it’s not consistent since it’s copy and pasted from different sources).

Essentially, I’d like to have a search function on the first worksheet “Sheet1” (so exclude summary page) which would create a list of data returned from all those regulation worksheets. There will sometimes be more than one incidence of the substances or EC number in different worksheets. This is good – I want to see if the substance is in multiple regulations. If the substance or EC number is found in any of the worksheets, I’d like the macro to return specific information from worksheet – namely the substance, CAS Number, EC Number (if available), and the regulation it’s from (another column).

I’ve googled searchable lists and other macros which do similar things to this but I think the main problem will be:

1. Skipping the summary page for searching
2. Returning specific information from each column for each worksheet and putting it into the right spot on the main search page.

If anyone could help me out I’d be ever so grateful. Thanks! If you need clarification please let me know and I’ll get back to you. If you need me to send the file, please pm me!

 

[gallen]

Re: Excel VBA search multiple sheets help

Hello and welcome

This is achievable. You just need to loop through every sheet excluding sheet 1 and perform a search

However your information is a little light:

• Which cell of "Sheet1" is the search text?

• What initiates the search? Every time the search cell is changed? or is there a button?

• When searching each sheet, are you searching every cell within the sheet or only a specific column(s)?

• You specify the information you want returning "to the right spot" but don't specify what the right spot is? Is it just a single cell?

• In which columns is the data you need returning?

• If the search term is found, is all the returning info found on the same row?

If you give as much information as you can you stand a much better chance of someone offering their help. From experience when you try and help a question like this it then grows into weeks off additional "add on" questions.

 

[jonobono8888]

Re: Excel VBA search multiple sheets help

Hello and welcome

This is achievable. You just need to loop through every sheet excluding sheet 1 and perform a search

However your information is a little light:

• Which cell of "Sheet1" is the search text?

• What initiates the search? Every time the search cell is changed? or is there a button?

• When searching each sheet, are you searching every cell within the sheet or only a specific column(s)?

• You specify the information you want returning "to the right spot" but don't specify what the right spot is? Is it just a single cell?

• In which columns is the data you need returning?

• If the search term is found, is all the returning info found on the same row?

If you give as much information as you can you stand a much better chance of someone offering their help. From experience when you try and help a question like this it then grows into weeks off additional "add on" questions.

Thanks so much for getting back to me. Here are the answers to your questions:

• I was thinking of actually having a search box / button configuration. So you type either the substance name, CAS or EC number into the box and click the button and then it'll search each of the sheets and print out anything that it matches with (or if it even contains that word/number). As such the cell in "Sheet1" isn't actually specified - it can be any that you want it to be/that's convenient. I haven't actually coded anything yet.
• With regards to searching, I'd be looking into maybe 3 separate columns of data in each worksheet (the columns containing "substances", "CAS Number" and "EC Number").
• The "right spot" would just be a table underneath the search area/button. Something like this:

[search box] [search button]

Results:
Column A (Substance) | Column B (CAS Number) | Column C (EC Number) | Column D (Regulation)
...
...
..

Ideally those headers will always be there and can be in a "filter" mode, so that when any results come up, the filtering ability is available.

• When doing a search - yes all the data will be in that row, just scattered into different columns. So worksheets may have like 7 columns of extra data, some may only have 2-3. So I'd want it to just take the relevant information out and output that to that search worksheet page.

Sorry if I wasn't clear in what I was wanting. Does this answer everything?

 

[jonobono8888]

Re: Excel VBA search multiple sheets help

• In which columns is the data you need returning?

Sorry I missed this question - this data I need returning are all in different columns of each worksheet (since each worksheet has varying amounts of information). Would it be much easier if I moved things around so that they are always consistently in the same columns?

 

[gallen]

Re: Excel VBA search multiple sheets help

• In which columns is the data you need returning?

Sorry I missed this question - this data I need returning are all in different columns of each worksheet (since each worksheet has varying amounts of information). Would it be much easier if I moved things around so that they are always consistently in the same columns?

If each sheet had the data laid out in the same way it would be easier to code, yes. Is the data in a defined table? If not, can it be?

 

[gallen]

Re: Excel VBA search multiple sheets help

OK, here is a start.

This code can be posted into a new module. It relies on you changing the 'Constants' to the correct column numbers for the denoted info.

I've tested it on primitive data and it works.

I've tried to comment as much as I can.

'These constants represent the column numbers of each of the desired results
'change where necessary
Const colSubstance As Integer = 1
Const colCASNumber As Integer = 2
Const colECNumber As Integer = 3
Const colRegulation As Integer = 4






Sub DoSearch()
    'this code relies on a defined table existing on sheet1 and that it is the first table on the sheet
    Dim shSearch As Worksheet, sh As Worksheet
    Dim sSearch As String 'search term to find
    Dim rFind As Range 'used to search
    Dim sFirst As String 'used to record the address of the first instance of
    Dim tblResults As ListObject
    Dim NewRow As ListRow
    
    
    
    Set shSearch = Worksheets("Sheet1")
    
    'set the table variable for easier coding
    Set tblResults = shSearch.ListObjects(1)
    
    'clear the table
    On Error Resume Next
    tblResults.DataBodyRange.EntireRow.Delete
'    With tblResults
'        .DataBodyRange.Rows(1).ClearContents 'clear first row
'        'Delete all other rows. Will error if none exist
'        .DataBodyRange.Offset(1, 0).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
'    End With
    On Error GoTo 0
    
    'get the search term, removing any leading or trailing spaces
    sSearch = Trim(shSearch.Range("A1"))
    
    'ignore blank search
    If Len(sSearch) = 0 Then Exit Sub
    
    'Loop through all sheets
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> shSearch.Name Then
            'try to find
            Set rFind = sh.UsedRange.Find(sSearch)
            
            If Not rFind Is Nothing Then 'search is found
                'record the first address
                sFirst = rFind.Address
AddRow:
                'Create a new row
                Set NewRow = tblResults.ListRows.Add
    
                NewRow.Range.Cells(1, 1) = sh.Cells(rFind.Row, colSubstance)
                NewRow.Range.Cells(1, 2) = sh.Cells(rFind.Row, colCASNumber)
                NewRow.Range.Cells(1, 3) = sh.Cells(rFind.Row, colECNumber)
                NewRow.Range.Cells(1, 4) = sh.Cells(rFind.Row, colRegulation)
                NewRow.Range.Cells(1, 5) = sh.Name & "[" & rFind.Address & "]"
                
                'continue searching the sheet for more instances
                Set rFind = sh.UsedRange.FindNext(rFind)
                'if found in a different loaction than the first one, add that row too
                If rFind.Address <> sFirst Then GoTo AddRow
            End If
            


        End If
        'reset find variable
        Set rFind = Nothing
    Next sh
    
End Sub

 

[jonobono8888]

Re: Excel VBA search multiple sheets help

@gallen.

Thanks so much. That worked perfectly for me. The comments were really helpful. I've amended it a bit myself to fit my data. I've also added in a clearing button for the table. You're the best!

 

[gallen]

Re: Excel VBA search multiple sheets help

Good news. Happy it pointed you in the right direction.

 

[jonobono8888]

Re: Excel VBA search multiple sheets help

Hi - So I'm reusing this code for another similar purpose but I'm unsure of how to tweak it to fit what I need.

The main change I need to this code is that instead of searching every worksheet for values, I only want it to search one specific worksheet (A database of some sort).

I know I need to change the "loop through all sheets" code but I'm not sure what to change. Could you give me a hand?

Thanks

 

[jonobono8888]

Re: Excel VBA search multiple sheets help

Two other things:

1. When I was testing the code, if the term was found in a column (despite it being in the same row), it'd post the same row 2-3 times? Ideally I'd only like each row of information being presented once
2. Is there a way I can keep the conditional formatting / all the formatting from the Main Database sheet when it is being copied over to the Search Box page?


Here is the current code:

'These constants represent the column numbers of each of the desired results
'change where necessary
Const colBusiness As Integer = 1
Const colDevice As Integer = 2
Const colProject As Integer = 3
Const colAssembly As Integer = 4
Const colAssemblyPart As Integer = 5
Const colComponent As Integer = 6
Const colComponentNum As Integer = 7
Const colClaiganNum As Integer = 8
Const colMatSup As Integer = 9
Const colMatType As Integer = 10
Const colMatInfo As Integer = 11
Const colCode As Integer = 12
Const colPatientCont As Integer = 13
Const colPatientDura As Integer = 14
Const colBiocompatibility As Integer = 15
Const colBioReport As Integer = 16
Const colEUMDRYR As Integer = 17
Const colSubsRep As Integer = 18
Const colEUMDR104 As Integer = 19
Const colEUMDR234 As Integer = 20
Const colReachSVHC As Integer = 21
Const colReachRest As Integer = 22
Const colCaProp As Integer = 23
Const colWEEE As Integer = 24
Const colROHS2 As Integer = 25
Const colROHS3 As Integer = 26
Const colEUPOP As Integer = 27
Const colPFOA As Integer = 28
Const colAUAsbestos As Integer = 29




Sub DoSearch()
'this code relies on a defined table existing on sheet1 and that it is the first table on the sheet
Dim shSearch As Worksheet, sh As Worksheet
Dim sSearch As String 'search term to find
Dim rFind As Range 'used to search
Dim sFirst As String 'used to record the address of the first instance of
Dim tblResults As ListObject
Dim NewRow As ListRow
Dim sName As String
Dim sFound As Boolean



Set shSearch = Worksheets("Search Database")
Set dbSearch = Worksheets("Main Database")

'set the table variable for easier coding
Set tblResults = shSearch.ListObjects(1)

'clear the table
On Error Resume Next
tblResults.DataBodyRange.EntireRow.Delete
' With tblResults
' .DataBodyRange.Rows(1).ClearContents 'clear first row
' 'Delete all other rows. Will error if none exist
' .DataBodyRange.Offset(1, 0).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
' End With
On Error GoTo 0

'get the search term, removing any leading or trailing spaces
sSearch = Trim(shSearch.Range("B2"))

'ignore blank search
If Len(sSearch) = 0 Then Exit Sub

'Loop through all sheets
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> shSearch.Name Then
'try to find
Set rFind = sh.UsedRange.Find(sSearch)

If Not rFind Is Nothing Then 'search is found
'record the first address
sFirst = rFind.Address

AddRow:
'Create a new row
Set NewRow = tblResults.ListRows.Add

NewRow.Range.Cells(1, 1) = sh.Cells(rFind.Row, colBusiness)
NewRow.Range.Cells(1, 2) = sh.Cells(rFind.Row, colDevice)
NewRow.Range.Cells(1, 3) = sh.Cells(rFind.Row, colProject)
NewRow.Range.Cells(1, 4) = sh.Cells(rFind.Row, colAssembly)
NewRow.Range.Cells(1, 5) = sh.Cells(rFind.Row, colAssemblyPart)
NewRow.Range.Cells(1, 6) = sh.Cells(rFind.Row, colComponent)
NewRow.Range.Cells(1, 7) = sh.Cells(rFind.Row, colComponentNum)
NewRow.Range.Cells(1, 8) = sh.Cells(rFind.Row, colClaiganNum)
NewRow.Range.Cells(1, 9) = sh.Cells(rFind.Row, colMatSup)
NewRow.Range.Cells(1, 10) = sh.Cells(rFind.Row, colMatType)
NewRow.Range.Cells(1, 11) = sh.Cells(rFind.Row, colMatInfo)
NewRow.Range.Cells(1, 12) = sh.Cells(rFind.Row, colCode)
NewRow.Range.Cells(1, 13) = sh.Cells(rFind.Row, colPatientCont)
NewRow.Range.Cells(1, 14) = sh.Cells(rFind.Row, colPatientDura)
NewRow.Range.Cells(1, 15) = sh.Cells(rFind.Row, colBiocompatibility)
NewRow.Range.Cells(1, 16) = sh.Cells(rFind.Row, colBioReport)
NewRow.Range.Cells(1, 17) = sh.Cells(rFind.Row, colEUMDRYR)
NewRow.Range.Cells(1, 18) = sh.Cells(rFind.Row, colSubsRep)
NewRow.Range.Cells(1, 19) = sh.Cells(rFind.Row, colEUMDR104)
NewRow.Range.Cells(1, 20) = sh.Cells(rFind.Row, colEUMDR234)
NewRow.Range.Cells(1, 21) = sh.Cells(rFind.Row, colReachSVHC)
NewRow.Range.Cells(1, 22) = sh.Cells(rFind.Row, colReachRest)
NewRow.Range.Cells(1, 23) = sh.Cells(rFind.Row, colCaProp)
NewRow.Range.Cells(1, 24) = sh.Cells(rFind.Row, colWEEE)
NewRow.Range.Cells(1, 25) = sh.Cells(rFind.Row, colROHS2)
NewRow.Range.Cells(1, 26) = sh.Cells(rFind.Row, colROHS3)
NewRow.Range.Cells(1, 27) = sh.Cells(rFind.Row, colEUPOP)
NewRow.Range.Cells(1, 28) = sh.Cells(rFind.Row, colPFOA)
NewRow.Range.Cells(1, 29) = sh.Cells(rFind.Row, colAUAsbestos)
'NewRow.Range.Cells(1, 5) = sh.Name & "[" & rFind.Address & "]"

'continue searching the sheet for more instances
Set rFind = sh.UsedRange.FindNext(rFind)
'if found in a different loaction than the first one, add that row too
If rFind.Address <> sFirst Then GoTo AddRow
End If



End If
'reset find variable
Set rFind = Nothing
Next sh

End Sub