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

M

matutko4

New Member
Joined
Jan 17, 2024
Messages
9
Office Version
  1. 2021
Platform
  1. Windows
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
 
Sort by date Sort by votes
mumps said:
Try:
VBA Code: 
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
Click to expand...

I found another bugs regarding this code , please see 2 videos down below

www.veed.io

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 www.veed.io

www.veed.io

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 www.veed.io
 
Upvote 0

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Try:
VBA Code: 
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
    If Target.CountLarge > 1 Then
        'Range("C4:H" & lRow).ClearContents
        For Each rng In Target
            Range("C" & rng.Row).Resize(, 6).ClearContents
            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
        On Error Resume Next
        lRow = Range("B" & Rows.Count).End(xlUp).Row
        Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
        On Error GoTo 0
    Else
        Range("C" & Target.Row).Resize(, 6).ClearContents
        For Each ws In Sheets
            If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                Set fnd = ws.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                End If
            End If
        Next ws
        On Error Resume Next
        lRow = Range("B" & Rows.Count).End(xlUp).Row
        Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
        On Error GoTo 0
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
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
    If Target.CountLarge > 1 Then
        'Range("C4:H" & lRow).ClearContents
        For Each rng In Target
            Range("C" & rng.Row).Resize(, 6).ClearContents
            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
        On Error Resume Next
        lRow = Range("B" & Rows.Count).End(xlUp).Row
        Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
        On Error GoTo 0
    Else
        Range("C" & Target.Row).Resize(, 6).ClearContents
        For Each ws In Sheets
            If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                Set fnd = ws.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                End If
            End If
        Next ws
        On Error Resume Next
        lRow = Range("B" & Rows.Count).End(xlUp).Row
        Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
        On Error GoTo 0
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
I really appreciate your help and patience :) but there is still one bug , if I want to delete entered / copied values by using "delete" button on keyboard it will fill column B with "sheet1" , please see video down below so you will understand it better , I'm not very good at explaining

VEED - Screen Recording - Jan 23, 2024

Or do you have better recommendation to delete those rows when I want to?
 
Upvote 0
Try:
VBA Code: 
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
    If Target.CountLarge > 1 Then
        For Each rng In Target
            If rng <> "" Then
                Range("C" & rng.Row).Resize(, 6).ClearContents
                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
                On Error Resume Next
                lRow = Range("B" & Rows.Count).End(xlUp).Row
                Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
                On Error GoTo 0
            Else
                Range("C" & rng.Row).Resize(, 6).ClearContents
            End If
        Next rng
    Else
        Range("C" & Target.Row).Resize(, 6).ClearContents
        If Target <> "" Then
            For Each ws In Sheets
                If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                    Set fnd = ws.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                    End If
                End If
            Next ws
            On Error Resume Next
            lRow = Range("B" & Rows.Count).End(xlUp).Row
            Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
            On Error GoTo 0
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
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
    If Target.CountLarge > 1 Then
        For Each rng In Target
            If rng <> "" Then
                Range("C" & rng.Row).Resize(, 6).ClearContents
                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
                On Error Resume Next
                lRow = Range("B" & Rows.Count).End(xlUp).Row
                Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
                On Error GoTo 0
            Else
                Range("C" & rng.Row).Resize(, 6).ClearContents
            End If
        Next rng
    Else
        Range("C" & Target.Row).Resize(, 6).ClearContents
        If Target <> "" Then
            For Each ws In Sheets
                If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                    Set fnd = ws.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                    End If
                End If
            Next ws
            On Error Resume Next
            lRow = Range("B" & Rows.Count).End(xlUp).Row
            Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
            On Error GoTo 0
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
Almost there, if i delete "entered values" with delete on keyboard and write number to column B by keyboard, it makes weird stuff, please see video.

www.veed.io

VEED - Screen Recording - Jan 24, 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 www.veed.io
 
Upvote 0
Try:
VBA Code: 
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
    If Target.CountLarge > 1 Then
        For Each rng In Target
            If rng <> "" Then
                Range("C" & rng.Row).Resize(, 6).ClearContents
                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
                On Error Resume Next
                lRow = Range("B" & Rows.Count).End(xlUp).Row
                Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
                On Error GoTo 0
            Else
                Range("C" & rng.Row).Resize(, 6).ClearContents
            End If
        Next rng
    Else
        Range("C" & Target.Row).Resize(, 6).ClearContents
        If Target <> "" Then
            For Each ws In Sheets
                If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                    Set fnd = ws.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                    End If
                End If
            Next ws
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 1
Solution
mumps said:
Try:
VBA Code: 
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
    If Target.CountLarge > 1 Then
        For Each rng In Target
            If rng <> "" Then
                Range("C" & rng.Row).Resize(, 6).ClearContents
                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
                On Error Resume Next
                lRow = Range("B" & Rows.Count).End(xlUp).Row
                Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
                On Error GoTo 0
            Else
                Range("C" & rng.Row).Resize(, 6).ClearContents
            End If
        Next rng
    Else
        Range("C" & Target.Row).Resize(, 6).ClearContents
        If Target <> "" Then
            For Each ws In Sheets
                If ws.Name <> "mastersheet" And ws.Name <> "mastersheet (2)" Then
                    Set fnd = ws.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                    End If
                End If
            Next ws
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
You are legend , you cant even imagine how you made my life easier , I implemented it to much complex workbook (where i have hundreds of sheets) and it work just as I need , THANK YOU !
 
Upvote 0
You are very welcome. :) I cleaned the code up a bit.
VBA Code: 
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
    If Target.CountLarge > 1 Then
        For Each rng In Target
            If rng <> "" Then
                Range("C" & rng.Row).Resize(, 6).ClearContents
                For Each ws In Sheets
                    If ws.Name <> "mastersheet" 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
                On Error Resume Next
                lRow = Range("B" & Rows.Count).End(xlUp).Row
                Range("C4:C" & lRow).SpecialCells(xlBlanks) = "Not Found"
                On Error GoTo 0
            Else
                Range("C" & rng.Row).Resize(, 6).ClearContents
            End If
        Next rng
    Else
        Range("C" & Target.Row).Resize(, 6).ClearContents
        If Target <> "" Then
            For Each ws In Sheets
                If ws.Name <> "mastersheet" Then
                    Set fnd = ws.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = ws.Name
                    End If
                End If
            Next ws
        End If
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Create sheet for every day of month using Master template, name each sheet as per day of month. VBA
Replies
4
Views
474
John_w
J
Y
  • Question Question
Consolidate all values from specific sheets into 1 master excel file
Replies
0
Views
109
yrga88
Y
S
  • Question Question
Extracting/copy work sheets to new workbook based on the work sheet cell text
Replies
3
Views
179
Micron
M
V
  • Question Question
Searching for text in textboxes in Excel
2
Replies
15
Views
389
DanteAmor
DanteAmor
B
  • Question Question
Update Variable Data from Multiple Worksheets in a Master Sheet
2
Replies
11
Views
738
mumps
mumps

Forum statistics

Threads
1,223,214
Messages
6,170,775
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top