Copy Find All Dialogue Box

About a week ago I found the solution to my goal (weeks of on and off searching) from this forum site however, the VBA code didn't work on my computer. I intend to post it here later since I don't have access to it now and can't find it. For now though, here is my question:

I need to "find all" of a specific word and produce a copy of that "find all" list. More specifically, I want a list of the cell names (Sheet1!A1, Sheet2!B52, Sheet3!C20, for example) where my search criteria is located. So if I'm looking for the word "Pizza" and it's found in those cells, I want to copy that whole list for multiple worksheets (each worksheet ranging from A1 through Z3000; gaining rows as the file is updated).

I have extremely limited VBA experience and am now reading books to understand it more. When I post the code, I'd also like to know how to fix it too.

Thx in advance.

MsBBStacker

Hi

This sounds interesting.

It is also quite simple. [ Famous Last Words ]

If I were you I would put this macro into your personal workbook so you can run it in any active workbook.

I will assume that this is agreeable and create something for you.

Try this Macro

Press Ctrl, shift and F on the attachment.

Public MyStr As String

Sub Selector()

'I am using row one for labels so my first usable row is row 2
pos = 2

'I want to delete the "Search Results" sheet if it exists, So I am going to force an error
On Error GoTo NewSheet

'This blocks the message "Deleting Sheet Will Lose Data"
Application.DisplayAlerts = False

'This selects the results sheet, if it does not exist then we will goto NewSheet
Sheets("Search Results").Select

'This Deletes the Results Sheet
ActiveSheet.Delete

'This re-enables our error messages
Application.DisplayAlerts = True

'Create the Results Sheet
NewSheet:
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Search Results"
    ActiveSheet.Move Before:=Sheets(1)

'What Text do you want to search for?
MyStr = InputBox("Enter Text to Find", "Find Text Macro", "select", 100, 100)

'These are my Labels
Range("A1").Value = strValueToPic
Range("C1").Value = "Hyperlink"

' This resets our normal error routines
On Error GoTo 0

'Quit if search text is empty
If MyStr = "" Then Exit Sub

'Search for the Search String in each workbook except the results sheet
For Each ws In Sheets

If ws.Name = "Search Results" Then GoTo Skip

MyName = ws.Name

    MyString = ""

    With ws.Cells
        Set rngFind = .Find(MyStr, .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            
            Do
                MyString = MyString & MyName & "!" & rngFind.Address & ", "
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
'If Match Found then store data in Column A of results sheet
    If MyString <> "" Then
    
'Convert MyString into an Array, so it is easy to save
        MyArray = Split(MyString, ",")
    
'Where to save MyArray
        Temp = Range(Cells(pos, 1), Cells(pos + UBound(MyArray), 1)).Address
        
'Save MyArray, The array is horizontal, transpose makes it vertical
        Sheets("Search Results").Range(Temp).Value = Application.Transpose(MyArray)
        
'We need to increment pos so the next lot of data is saved below the existing data
       pos = pos + UBound(MyArray)
        
    End If

Skip:

Next

'This Creates The Hyperlinks in Column C
With Sheets("Search Results")

For Count = 2 To pos - 1

Temp = CStr(Application.Trim(Sheets("Search Results").Cells(Count, 1)))

ActiveSheet.Hyperlinks.Add Anchor:=.Cells(Count, 3), Address:="", SubAddress:=Temp, TextToDisplay:=Temp
        
Next


End With
End Sub

Test testing.....

Hopefully this message will get through. Having troubles accessing the forums on my computer but my phone won't let me reply.

Thank you so much mehmetcik for the code. It worked perfectly and better than even the code I found before, tried, and lost (if that code had worked). It was broken anyway and I didn't know how to fix it. Thanks again. I'll post a sample of my file with an explanation of what I'm using it for when my computer quits being stubborn.

MsBBS

PS. My cell is acting like computer in regard to forum access. :-(

Thanks for the feedback.