Need Help URGENT (SEARCH ENTIRE WORKBOOK)

[akhorasi]

Hi,

I have got a problem which I dont know how to fix it properly and efficiently.
Problem 1:
I have a excel file that contain many hyperlinks(each connecting to its own excel file)
Is there any way to copy every excel hyperlink in one entire workbook.

Problem 2:
Once problem1 is solved , is there any efficient way to provide a input text bar to user to seach for string in entire workbook. I just want to avoid manual checking of each excel file for that string.
Thanks,

I can provide you with excel file that contain hyperlinks if somebody is willing to help me with exact proper straight solution. I will really appreciate it.
Help me please.

 

[HalfAce]

Hi,
For 'problem 1', here's a routine for listing all the hyperlinks in the (active) workbook.

Sub ListHyperLinks()
Dim WkSht As Worksheet
Dim hLink As Long
On Error Resume Next
Sheets("hLinks").Delete
On Error GoTo 0
Sheets.Add().Name = "hLinks"
For Each WkSht In Worksheets
  If WkSht.Name <> "hLinks" Then
    For hLink = 1 To WkSht.UsedRange.Hyperlinks.Count
      WkSht.Hyperlinks(hLink).Range.Copy
      With Sheets("hLinks")
        .Cells(Rows.Count, 1).End(xlUp)(2).Value = WkSht.Name
        .Cells(Rows.Count, 2).End(xlUp)(2).PasteSpecial
        .Cells(Rows.Count, 3).End(xlUp)(2) = WkSht.Hyperlinks(hLink).Range.Address
      End With
      Application.CutCopyMode = False
     Next hLink
   End If
Next WkSht
End Sub

For 'problem 2', here's what I use to search through entire workbooks.

Sub SearchWholeWorkbook()
Dim SearchVal, _
    Ws As Worksheet, _
    HiddenState As Boolean, _
    Rng As Range, RngCell As Range, _
    FoundCount As Long, _
    ThisSheet As String, FrstAddrss As String, _
    MsgTxtLn1 As String, MsgTxtLn2 As String
SearchVal = InputBox("Search for what....", "Enter Search Value")
If Len(SearchVal) = 0 Then MsgBox "No search criteria", , "No Search": Exit Sub
ThisSheet = ActiveSheet.Name
FoundCount = 0
For Each Ws In ThisWorkbook.Worksheets
      HiddenState = Ws.Visible
      Ws.Visible = True
      Ws.Select
      Set Rng = Cells
      Set RngCell = Rng.Find(What:=SearchVal, After:=[A1], LookIn:=xlFormulas, lookat:= _
          xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
      If Not RngCell Is Nothing Then
        FrstAddrss = RngCell.Address
        FoundCount = FoundCount + 1
        Do
          RngCell.Select
          If MsgBox(SearchVal & " found on sheet " & ActiveSheet.Name & " cell " & _
             RngCell.Address(0, 0) & vbNewLine & "Want to find the next?", _
             vbYesNo, "Continue Searching?") = vbNo Then Exit Sub
          Set RngCell = Rng.FindNext(RngCell)
                    
        Loop While RngCell.Address <> FrstAddrss
      End If
      Ws.Visible = HiddenState
Next
Select Case FoundCount
  Case 0
    MsgTxtLn1 = SearchVal & " could not be found anywhere in this workbook."
    MsgTxtLn2 = vbNewLine & vbNewLine & "Another search?"
    MsgTitle = SearchVal & " Not Found"
  Case 1
    MsgTxtLn1 = "All instances of " & SearchVal & " in this workbook have been found."
    MsgTxtLn2 = vbNewLine & vbNewLine & "Another search?"
    MsgTitle = SearchVal & " Found One Time"
  Case Else
    MsgTxtLn1 = "All instances of " & SearchVal & " have been found in this workbook."
    MsgTxtLn2 = vbNewLine & vbNewLine & "Another search?"
    MsgTitle = SearchVal & " Found Multiple Times"
End Select
  Sheets(ThisSheet).Select
  If MsgBox(MsgTxtLn1 & MsgTxtLn2, vbYesNo, MsgTitle) _
     = vbYes Then
    SearchWholeWorkbook
  End If
End Sub

Either of these help?

 

[akhorasi]

Thanks,

For Problem 1 , I didnt really understand anything but problem 1 is not that important as we can manually move the worksheets of each hyperlink in one workbook.


for problem 2, its workin but not all the woork book. Only Front -page where button is provided for validation . thanks.

 

[akhorasi]

For Problem 2 , I cannot Search entire work book's Sheets . Its only searching for first sheet where button is kept.


thanks, I really appreciate your efforts .

 

[HalfAce]

Is there any way to copy every excel hyperlink in one entire workbook.

OK, for problem 1, I thought you just wanted to list all the hyperlinks in the workbook in one location, so that's all that code does.

For problem 2, where did you store that code?
If it's in a standard code module it'll search the entire workbook, even un-hiding any hidden worksheets to search through those too.
If you stored that code in the sheet module of your sheet with the button, then it would only search through that one sheet.

 

[akhorasi]

Yes it was stored in the sheet module. sheet 1 .
How to make it standard one . I am kind of newbie in excel.
Thanks for your help . I really appreciate it .

 

[akhorasi]

Thanks , Yes I got it on how to do the problem 2 .

For Problem1 , may b I didnt clear you my point. I have one excel file that have many hyperlinks already into it. So when I click any of the hyperlink in that excel file . It will open the new excel file connected to that hyperlink . My question was how to transfer every excel file without clicking on hyperlink again and again into one workbook.
Is there any way , that we can provide button that will automatically transfer updated hyperlink excel file into workbook that we have .

Thanks,

 

[akhorasi]

Hi,
Thanks For the help

I have similar problem same as searchWholeWorkbook.

Now problem is I have one column , that stores a reserved system Numbers like
T-84-002 till T-84-006 and Project ID :12345 (Column AJ starting from row 3 )

STRUCTURE :
Plan Area (PA) - Function Code( FC) - Number
T-84-002 (Reserve System Number)

so I have different sheets in one workbook containing same structure but different Reserved System numbers.

I need to make button , that will ask user to enter the reserve System number.
Now the problem is , : user can enter anything :
Case 1 : T-TNK-84-002A ====>>> EXIST , PASSED YES ITS IN SYSTEM

CASE 2 : T-84-005 ===> EXIST , PASSED YES ITS IN SYSTEM

CASE 3 : T-TNK-84-009A ==> Does NOT EXIST : WARNING USE THE NUMBER FROM T-84-002 till T-84-006 in a list table section Reserve number lists alon with proj ID Use That First .

CASE 4 : T-TNK-85-1001 ===>> IGNORE THAT (IF Its 4 digits last section 1001 ignore)

'
BASICALLY : we have to check PA , FC to be same .

Thanks ,

 

[akhorasi]

adding more minor details in it .
The Equipment Location holds : T-84-002 till T-84-006 in each rows ,
or any other numbers like A-86-050 till A-86-064 .
Column is P , Range is also defined on the sheet which is named as Position_Equip_Loc2 for whole number of systems numbers located in column Equipment Location.

Thanks,

 

[akhorasi]

So far I have written this much code . This is for the first time I am coding in VBA . I dont know what to do . I got the logic but dont know how to do it . I am also having problem in listing down all the reservation number on the form type template with all the required information on it .
I have commented some of the things that I am not sure how to do it . Please add your code too . what you think is right . THanks


CODE IN VBA
Sub VerifyReserveNumber()
Dim reserveSysArray As Variant 'An array used for user input
Dim foundPAFC As Boolean 'true if PA and FC of existing list matches with the entered number
Dim uPA, uFc, uNum ' User PlanArea , User FunctionCode , User Number
Dim ws As Worksheet
Dim lastRow As Integer
Dim projectID As String
Dim rn As String ' Single Cell's Reservation Number (parent System)
Dim reserveNum As Range 'Parent System Number list for current sheet (Equipement location P column
Dim arrSysNum As Variant 'an array that stores the parts of a system number eg. plan area, PFC, number
Dim planArea As String
Dim PFC As Long
Dim num As Long 'stores the number portion of the system number eg. (plan area - PFC - number)
foundPAFC = False

' Input box will be prompt to user to enter the reservation number he is looking for
SearchVal = InputBox("Enter the Validation/Searching value", "Enter Reservation Number")
' If user leaves it blank , box will appear saying no input found
If Len(SearchVal) = 0 Or SearchVal = " " Then MsgBox "No input found ", , "No Search": Exit Sub
reserveSysArray = Split(SearchVal, "-")
uPA = reserveSysArray(0)
uFc = reserveSysArray(1)
uNum = reserveSysArray(2) ' might contain "053A" or "053 only" for eg.
If IsNumeric(uNum) = False Then ' means it contain last alphabet and digits both
uNum = Left(uNum, Len(uNum) - 1) ' Will remove the last alphabet Character from the string
If Len(uNum) > 3 And IsNumeric(uNum) = True Then
MsgBox "Non-Maintained Number : No validation required for that ", , "Exiting": Exit Sub

' ***Start Iterating through Each Worksheets and list down all the reserve number which meet conditions ***
For Each ws In ThisWorkbook.Worksheets 'will check each worksheet one by one in whole workbook
HiddenState = ws.Visible 'store the visibility state of the sheet.
ws.Visible = True 'Visibility turn on temporarily if its off for checking whole data

Set reserveNum = ws.Range("Position_Equip_Loc2")
For Each rn In reserveNum
'rn is one single reserve number
arrSysNum = Split(rn, "-")
planArea = arrSysNum(0)
PFC = arrSysNum(1)
num = arrSysNum(2)
If planArea = uPA And PFC = uFc Then
foundPAFC = True 'if true then list down all the reserve num meeting that condition
'???????
'????? '??? also include PROJECTID for the following row too ,
'***** If possible show it on form " I have no idea
' ? ????


End If
Next

Next
End Sub