VBA Help Please! Create Hyperlink

[Danr]

• just need some help with a hyperlink.
  
  I have code below that does the following;
  1. Data is entered into a row in a file called Problem Tracking.xls
  2. Data is then transferred into a file called SQD Master after opening the file
  3. A folder is Created and the SQD Master File is saved in the created Folder and remains open.
  
  This is where I need help with a hyperlink. I now want the file saved in the folder to be hyperlinked into the Problem Tracking.xls using Text from Column 19 or S. This is a number that is entered by someone before running the macro.
  
  Thanks
  
  
  

  <code>Sub FillSQD()
  
  'ADD COLUMN NUMBERS AS NECESSARY
  
  'GOOD HABIT TO USE LONG FOR ROW NUMBER VARIABLES
      Dim lRowToCopy As Long, lColCnt As Long
      
      
  'VARIABLE TO HOLD ARRAY OF COLUMN VALUES
      Dim vColumns As Variant, vRowNumber As Variant
      Dim wbSSM As Workbook
      
      
  'THIS DETERMINES WHICH ROW THE DATA WILL BE TRANSFERRED TO THE SQD FORM
      vRowNumber = InputBox("ENTER THE ROW NUMBER TO TRANSFER TO SQD")
  'ALWAYS CHECK FOR VALID INPUT
      If Not IsNumeric(vRowNumber) Then
          MsgBox "Number was expected as input"
          Exit Sub
      End If
      
      RowToCopy = vRowNumber
      
      
  'ASSIGN THE VALUES IN EACH COLUMN TO THE VARIABLES, IF MORE
  'COLUMNS, JUST ADD MORE BY CHANGING 'T' TO CORRECT COLUMN
      
  'COPY THE VALUES OF THIS ROW INTO AN ARRAY
      vColumns = Range("A" & RowToCopy & ":v" & RowToCopy).Value
      'OCCURANCE DATE in vColumns(1,2)
      'PROBLEM DESCRIPTION in vColumns(1,4)
      'WHERE FOUND in vColumns(1,5)
      '# OF DEFECTS FOUND in vColumns(1,6)
      'SUPPLIER NAME in vColumns(1,8)
      'PART NAME in vColumns(1,9)
      'PART NUMBER in vColumns(1,10)
      'BAR CODE/SERIAL# in vColumns(1,11)
      'SQD NUMBER in vColumns(1,19)
      'SQD ISSUE DATE in vColumns(1,20)
      'DUE DATE in vColumns(1,21)
      
      
  'CHECK FOR VALID INPUT
      If vColumns(1, 19) = "" Then
          MsgBox ("SQD LOG NUMBER IS NEEDED TO CONTINUE")
          GoTo CleanUp
      ElseIf vColumns(1, 8) = "" Then
          MsgBox ("SUPPLIER NAME IS NEEDED TO CONTINUE")
          GoTo CleanUp
      Else
      
     
  'NOW TURN THEM ALL TO UPPER CASE. WORKING IN ARRAYS IS VERY FAST
      For lColCnt = 1 To UBound(vColumns, 2)
          vColumns(1, lColCnt) = UCase(vColumns(1, lColCnt))
      Next lColCnt
      
      
  'CHANGE FILE PATH BELOW TO ISO FORM
  'ALWAYS SET A WORKBOOK VARIABLE TO A FILE YOU OPEN SO YOU CAN ADDRESS THAT FILE PROPERLY AND KNOW WHAT  YOU ARE DOING IN WHICH FILE.
      Set wbSSM = Workbooks.Open(Filename:= _
      "F:\Copy Test\2015 SQD\Supplier SQD Master.xls")
      
      
  'SAVE THE ROW VALUES TO PARTICULAR FIELDS IN THE MASTER
      With wbSSM.Sheets("SQD")
      
      .Range("C7").Value = vColumns(1, 2) 'OCCURANCE DATE
      .Range("A12").Value = vColumns(1, 4) 'PROBLEM DESCRIPTION
      .Range("H7").Value = vColumns(1, 5) 'WHERE FOUND
      .Range("H8").Value = vColumns(1, 6) '# OF DEFECT FOUND
      .Range("C5").Value = vColumns(1, 8) 'SUPPLIER NAME
      .Range("C6").Value = vColumns(1, 9) 'PART NAME
      .Range("H6").Value = vColumns(1, 10) 'PART NUMBER
      .Range("C8").Value = vColumns(1, 11) 'BAR CODE/SERIAL #
      .Range("G4").Value = vColumns(1, 19) 'SQD #
      .Range("E4").Value = vColumns(1, 20) 'SQD ISSUE DATE
      .Range("I15").Value = vColumns(1, 21) 'DUE DATE
    
      x = MsgBox("ADD ANY ADDITIONAL INFORMATION AND PICTURES INTO SQD FORM AND SAVE")
      
  'THIS WORKBOOK IS THE WORKBOOK HOLDING THIS MACRO
  
      
  'THIS CREATES FOLDER TO LOCATION
      MkDir "F:\Copy Test\2015 SQD\Issued\" & .Range("G4") & " " & Range("C5").Value
      
      
  'THIS SAVES SQD FILE AS FILENAME IN CREATED FOLDER
      ActiveWorkbook.SaveAs Filename:="F:\Copy Test\2015 SQD\Issued\" & Range("G4") & " " & Range("C5").Value & "\" & Range("G4") & " " & Range("C5").Value
      
        
  CleanUp:
      Set wbSSM = Nothing
  End With
  End If

  
  
  </code>
  ​

 

[RickXL]

Hi,

The way to create a hyperlink is something like this:

Sub hyper()
    With ThisWorkbook.Worksheets(1)
        .Hyperlinks.Add Anchor:=.Range("B1"), _
            Address:=ActiveWorkbook.FullName, _
            ScreenTip:="My Hyperlink", _
            TextToDisplay:="Data File"
    End With
End Sub

I am not entirely clear how many workbooks you have open or what the sheet names are so you may need to adjust the names above to work for you.