I have done a new code for you, check this out
Sub find_text()
Dim ws As Worksheet
Dim startrow As Integer
Dim startcol As Integer
Dim endrow As Integer
Dim endcol As Integer
Dim find_text As String
Dim pasterow As Integer
Dim cell_address As String
pasterow = 1
find_text = InputBox("Please enter the text you need to find")
For Each ws In ThisWorkbook.Sheets
If ws.Name = "Find_Text" Then
Application.DisplayAlerts = False
ws.Delete
End If
Next
ThisWorkbook.Sheets.Add
ActiveSheet.Name = "Find_Text"
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Find_text" Then
endrow = ws.Cells(1, 1).SpecialCells(xlLastCell).Row
endcol = ws.Cells(1, 1).SpecialCells(xlLastCell).Column
startrow = 1
Do While startrow <= endrow
startcol = 1
Do While startcol <= endcol
If ws.Cells(startrow, startcol) = find_text Then
cell_address = ws.Cells(startrow,
startcol).Address
ThisWorkbook.Sheets("Find_text").Cells(pasterow,
1).Select
ActiveCell.Hyperlinks.Add Anchor:=Selection,
Address:="", SubAddress:= _
ws.Name & "!" & cell_address,
TextToDisplay:=ws.Name & " " & cell_address
pasterow = pasterow + 1
End If
startcol = startcol + 1
Loop
startrow = startrow + 1
Loop
'MsgBox endrow & endcol
End If
Next
End Sub
On Jun 12, 8:56 pm, Ane <anelisago...@gmail.com> wrote:
> Hi,
>
> I'm making a macro to search words in the workbook ....
> it creates a sheet "FindWord" with a link for the word ... as the
> example:
>
> Occurences of: test
>
> Location Cell Text
> Sheet1!F20 test
> Sheet2!D50 test
> Sheet5!C5 test
>
> I notice that the function is with two errors:
>
> 1º - do not find values in merged cells
>
> 2º - do note find values in hidden cells
>
> 'this the part of the macro that makes the Search
>
> Public Sub FindAll(Search As String, Reset As Boolean)
>
> Dim WB As Workbook
> Dim WS As Worksheet
> Dim Cell As Range
> Dim Prompt As String
> Dim Title As String
> Dim FindCell() As String
> Dim FindSheet() As String
> Dim FindWorkBook() As String
> Dim FindPath() As String
> Dim FindText() As String
> Dim Counter As Long
> Dim FirstAddress As String
> Dim Path As String
> Dim MyResponse As VbMsgBoxResult
>
> If Search = "" Then
> GoTo Canceled
> End If
>
> Application.DisplayAlerts = False
> Application.ScreenUpdating = False
>
> 'Save found addresses and text into arrays
> On Error Resume Next
> Set WB = ActiveWorkbook
> If Err = 0 Then
> On Error GoTo 0
> For Each WS In WB.Worksheets
> 'Omit results page from search
> If WS.Name <> "FindWord" Then
> With WB.Sheets(WS.Name).Cells
> Set Cell = .Find(What:=Search, LookIn:=xlValues,
> LookAt:=xlPart, _
> MatchCase:=False, SearchOrder:=xlByColumns)
> If Not Cell Is Nothing Then
> FirstAddress = Cell.Address
> Do
> Counter = Counter + 1
> ReDim Preserve FindCell(1 To Counter)
> ReDim Preserve FindSheet(1 To Counter)
> ReDim Preserve FindWorkBook(1 To Counter)
> ReDim Preserve FindPath(1 To Counter)
> ReDim Preserve FindText(1 To Counter)
> FindCell(Counter) = Cell.Address(False,
> False)
> FindText(Counter) = Cell.Text
> FindSheet(Counter) = WS.Name
> FindWorkBook(Counter) = WB.Name
> FindPath(Counter) = WB.FullName
> Set Cell = .FindNext(Cell)
> Loop While Not Cell Is Nothing And
> Cell.Address <> FirstAddress
> End If
> End With
> End If
> Next
> End If
>
> 'Here I create a sheet "FindWord" with all occurrences found
>
> 'Create FindWord sheet in does not exist
> On Error Resume Next
> Sheets("FindWord").Select
> If Err <> 0 Then
> Debug.Print Err
> 'error occured so clear it
> Err.Clear
> Sheets.Add.Name = "FindWord"
> Sheets("FindWord").Move After:=Sheets(Sheets.Count)
>
> 'Run macro to add code to ThisWorkbook
> AddSheetCode 'veja abaixo o código
> End If
>
> (' Formatting code)
>
> end sub
>
> 'that the macro that inserts the results found in the sheet "FindWord"
>
> Sub AddSheetCode()
> Dim strCode As String
> Dim FWord As String
> Dim WB As Workbook
> Dim Sh
> Dim I As Integer
> Set WB = ActiveWorkbook
>
> 'Line to be inserted instead of 4th line below if code in
> Personal.xls
> '& "Application.Run (" & Chr(34) & "Personal.xls!Search.FindAll"
> & Chr(34) & "), Target.Text, " & Chr(34) & "False" & Chr(34) & vbCr _
> 'Optional 4th line if code in workbook
> '& "FindAll Target.Text, " & Chr(34) & "False" & Chr(34) & vbCr _
>
> strCode = "Private Sub Workbook_SheetChange(ByVal Sh As Object,
> ByVal Target As Range)" & vbCr _
> & "If Sh.Name = " & Chr(34) & "FindWord" & Chr(34) & " Then" &
> vbCr _
> & "If Target.Address = " & Chr(34) & "$B$1" & Chr(34) & " Then" &
> vbCr _
> & "Application.Run (" & Chr(34) & "Personal.xls!Search.FindAll" &
> Chr(34) & "), Target.Text, " & Chr(34) & "False" & Chr(34) & vbCr _
> & "Cells(1,2).Select" & vbCr _
> & "End if" & vbCr _
> & "End if" & vbCr _
> & "End Sub"
> 'Debug.Print strCode
>
> 'Write code to ThisWorkbook module
> FWord = "ThisWorkbook"
> For I = 1 To WB.VBProject.VBComponents.Count
> If WB.VBProject.VBComponents.Item(I).Name = FWord Then
> Exit For
> End If
> Next
> If Not WB.VBProject.VBComponents.Item(I).CodeModule Is Nothing
> Then
> If Not WB.VBProject.VBComponents.Item(I).CodeModule.Find
> ("Workbook_SheetChange", 1, 1, 100, 100) Then
> WB.VBProject.VBComponents.Item(I).CodeModule.AddFromString
> (strCode)
> End If
> End If
> Set WB = Nothing
>
> End Sub
>
> It is not working as I would like ....
>
> Do you have any notion which error is this???
> And where am I missing in the code ... ?
>
> Thanks for the help ...
>
> Ane
--~--~---------~--~----~------------~-------~--~----~
-------------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---
