Need help on Hyperlinking a value keyed in by the user.

[Fiske]

Hi all.
i am doing a code where when the user input the part number, the code will search the input part number by the user in specific folder directory, and hyperlink the input values to the found folder without changing the input values. However, in the directory folder, there is a lot of subfolders within subfolders. Furthermore, inside the found folder, there is also another subfolder in it.
This is my current code as of now.

Private Sub CommandButton1_Click()Dim Name, desp, iname, prtno, fldr, folder, fpath As String
Dim i, z As Integer


1:
  Name = InputBox("Company name?")
  If Name <> "" Then
  If IsEmpty(Cells(1, 1)) Then
  Cells(1, 1).Value = Name
  Else
  Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Name
  End If
  End If


  prtno = InputBox("part no?")
  If prtno <> "" Then
  If IsEmpty(Cells(1, 2)) Then
  Cells(1, 2).Value = prtno
  Else
  Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = prtno
  End If
  End If
[COLOR=#ff0000]  fldr = "H:\Folder"
  With FileSearch
  .NewSearch
  .LookIn = fldr
  .SearchSubfolders = True
  .Filename = prtno
  End with
  Folder = .FoundFolder
  .Hyperlinks.Add Anchor:=ActiveCells,_ TextToDisplay:= j[/COLOR][COLOR=#ffff00]
[/COLOR]
  desp = InputBox("Part Description?")
  If desp <> "" Then
  If IsEmpty(Cells(1, 3)) Then
  Cells(1, 3).Value = desp
  Else
  Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = desp
  End If
  End If


  iname = InputBox("Name?")
  If iname <> "" Then
  If IsEmpty(Cells(1, 4)) Then
  Cells(1, 4).Value = iname
  Else
  Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = iname
  End If
  End If
  
  i = msgbox("Continue?", vbYesNo)
  If i = vbYes Then GoTo 1 Else GoTo 2
2:
  msgbox ("End")
  
  


End Sub

I have highlighted the area where i put the hyperlink in red so you guys can see it more clearly.
What i need is that the code will find the main folder for the part number and hyperlink it with out hyperlinking the sub folder inside the main folder. Hope you guys can help!
As i am still new to VBA i hope you guys can help me and also give me some info regarding hyperlinking.
Thanks you!

 

[Fiske]

Hi all!
this is my code as of now,

Private Sub CommandButton1_Click()Dim Name, desp, iname, prtno, fldr, fil As String
Dim i As Integer
Dim y As Variant
Dim z As Long


1:
  Name = InputBox("Company name?")
  If Name <> "" Then
  If IsEmpty(Cells(951, 1)) Then
  Cells(951, 1).Value = Name
  Else
  Cells(Rows.Count, 1).End(xlUp).Offset(951, 0).Value = Name
  End If
  End If


  
  y = Application.InputBox("Enter Book")
  If y = False And Not TypeName(y) = "String" Then Exit Sub
  Application.ScreenUpdating = False
  
  
  With Application.FileDialog(msoFileDialogFolderPicker)
  fldr = "C:\Users\11tsstudent\Desktop\code test"
  End With
    
  With Application.FileSearch
        .NewSearch
        .LookIn = fldr
        .SearchSubFolders = True
        .Filename = y
  End With
  fil = .FoundFiles
  With Active.workseet
  .Hyperlinks.Add Anchor:=.Cells(951, 2), _
   Address:=.fil, _
   TextToDisplay:=y
   End With
  If IsEmpty(Cells(951, 2)) Then
  Cells(951, 2).Value = y
  Else
  Cells(Rows.Count, 2).End(xlUp).Offset(951, 0).Value = y
  End If
  
  
  desp = InputBox("Part Description?")
  If desp <> "" Then
  If IsEmpty(Cells(951, 3)) Then
  Cells(951, 3).Value = desp
  Else
  Cells(Rows.Count, 3).End(xlUp).Offset(951, 0).Value = desp
  End If
  End If


  iname = InputBox("Name?")
  If iname <> "" Then
  If IsEmpty(Cells(951, 4)) Then
  Cells(951, 4).Value = iname
  Else
  Cells(Rows.Count, 4).End(xlUp).Offset(951, 0).Value = iname
  End If
  End If
  
  i = MsgBox("Continue?", vbYesNo)
  If i = vbYes Then GoTo 1 Else GoTo 2
2:
  MsgBox ("End")
  
  


End Sub

I still cant seem to get the search hyperlink working
Need help!