Find value in workbook written in cell in master sheet and get names of sheets where it was found

[matutko4]

Hello ,

first of all , I am pretty new to VBA and mostly i just copy and paste codes and try to put them together , so i would like to ask for help

i do have workbook with more than 200 sheets , on master sheet called "Domov"
i would like to have search cell where if i write value it will go trough whole workbook and find on which sheets it found the value , than under the search cell it would write sheets names (names of sheets where value was found)

thank you in advance

 

[skillilea]

This should do it.

Sub FindStringInAllSheets()
Dim ws As Worksheet
Dim masterSheet As Worksheet
Dim searchWord As String
Dim resultString As String
Dim i As Long

Set masterSheet = ThisWorkbook.Sheets("MasterSheet")

searchWord = masterSheet.Range("A2").Value

resultString = ""

For Each ws In ThisWorkbook.Sheets
If ws.Name <> "MasterSheet" Then
If WorksheetFunction.CountIf(ws.UsedRange, "*" & searchWord & "*") > 0 Then
resultString = resultString & ws.Name & ", "
End If
End If
Next ws

resultString = Left(resultString, Len(resultString) - 2)
masterSheet.Range("A5").Value = resultString
End Sub

 

[mumps]

Start with a blank sheet and name it "Summary". Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet "Summary" and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter the search value in cell A1 and press the RETURN key. The sheet names that contain the search value will be listed in column A. You can change the range (in red) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim ws As Worksheet, fnd As Range
    For Each ws In Sheets
        If ws.Name <> "Summary" Then
            Set fnd = ws.UsedRange.Cells.Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                Cells(Rows.Count, "A").End(xlUp).Offset(1) = ws.Name
            End If
        End If
    Next ws
End Sub

 

[matutko4]

Start with a blank sheet and name it "Summary". Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet "Summary" and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter the search value in cell A1 and press the RETURN key. The sheet names that contain the search value will be listed in column A. You can change the range (in red) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim ws As Worksheet, fnd As Range
    For Each ws In Sheets
        If ws.Name <> "Summary" Then
            Set fnd = ws.UsedRange.Cells.Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                Cells(Rows.Count, "A").End(xlUp).Offset(1) = ws.Name
            End If
        End If
    Next ws
End Sub

Hello ,

thank you for your quick answer , your code work perfectly , there is only one think which I need different ( I did not specify it in my first post) I would like to do the same but for several numbers at once , i uploaded photo so it will be more clear what I mean

 

[mumps]

I'm sorry but I don't follow. It is hard to work with a picture. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing'
and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[matutko4]

I'm sorry but I don't follow. It is hard to work with a picture. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing'
and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Hello,

I am sorry to make it unclear, I will try to be more specific , please see link to excel file down below ,

example workbook.xlsx

Shared with Dropbox

www.dropbox.com

I hope it is more clear right now , thank you for your patience

I would like to have table for example as in my workbook , at B4:B13 i would like to enter values , those values can appear on multiple sheets (as it does in my example excel workbook) on the right side of the table C4:H13 I would like to have names of sheets where values from B4:B13 was found. In workbook which I send you I wrote it manually , but I want to automate it

example of usage : person will have several numbers in another excel , they will copy them , paste them to table under "enter values you are looking for" , after that , VBA would automatically fill column C,D,E etc. with name of column where value was found (depends on how many sheets value was found)

1​	A	B	C	D	A	B	C	D
2​
3​		enter values you are looking for	entered value in B3:B13 was found in this sheets :
4​		11	sheet1
5​		12	sheet1
6​		22	sheet1	sheet2
7​		23	sheet1	sheet2
8​		41	sheet4
9​		61	not found
10​
11​
12​
13​

I hope it is more clear right now , thank you for your patience

 

[mumps]

Try this macro in the worksheet code module:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim ws As Worksheet, fnd As Range, rng As Range, lRow As Long
    For Each rng In Target
        For Each ws In Sheets
            If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                Set fnd = ws.Range("B:B").Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Cells(rng.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                End If
            End If
        Next ws
    Next rng
    lRow = Range("B" & Rows.Count).End(xlUp).Row
    Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
    Application.ScreenUpdating = True
End Sub

 

[matutko4]

Try this macro in the worksheet code module:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim ws As Worksheet, fnd As Range, rng As Range, lRow As Long
    For Each rng In Target
        For Each ws In Sheets
            If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                Set fnd = ws.Range("B:B").Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Cells(rng.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                End If
            End If
        Next ws
    Next rng
    lRow = Range("B" & Rows.Count).End(xlUp).Row
    Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
    Application.ScreenUpdating = True
End Sub

Hello,

thank you , it works , but only for one time use , when i tried to delete the cells so i can put there new values it makes fancy stuff

everyday values in every sheet changes , so i need to have possibility to copy new values in column B

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim ws As Worksheet, fnd As Range, rng As Range, lRow As Long
    lRow = Range("B" & Rows.Count).End(xlUp).Row
    Range("C4:H" & lRow).ClearContents
    For Each rng In Target
        For Each ws In Sheets
            If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                Set fnd = ws.Range("B:B").Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Cells(rng.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                End If
            End If
        Next ws
    Next rng
    lRow = Range("B" & Rows.Count).End(xlUp).Row
    Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
    Range("B4", Range("B" & Rows.Count).End(xlUp)).ClearContents
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[matutko4]

Hello ,

thank you very much , we are almost there , the only issue right now is that values in B are disappearing , please see video on link down below

VEED - Screen Recording - Jan 23, 2024

Make stunning videos with a single click. Cut, trim, crop, add subtitles and more. Online, no account needed. Try it now, free. VEED

www.veed.io