Hi everyone, I have code that creates a hyperlink in an excel sheet in A1 but I need it to actually hyperlink to the file that was created in the folder. This code I have so far will only open to the folder path not the file path.
Thanks
Thanks
Code:
Sub FillMRDT()
'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
Dim wbSSM As Workbook
Dim strPath As String, strFile As String
Dim rngHLink As Range
'THIS DETERMINES WHICH ROW THE DATA WILL BE TRANSFERRED TO THE NON-CONFORMANCE FORM
'Type:=1 validates numbers
RowToCopy = Application.InputBox("ENTER THE ROW NUMBER TO TRANSFER INFORMATION TO MRDT FORM", "Transfer Row", Type:=1)
If RowToCopy < 1 Then Exit Sub 'User canceled
'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
'MRDT No VColumns (1,1)
'DATE in vColumns(1,2)
'CUSTOMER ORDER# in vColumns(1,3)
'DEPARTMENT in vColumns(1,4)
'CLOCK# in vColumns(1,5)
'PART# in vColumns(1,6)
'QTY in vColumns(1,7)
'COLOUR IN vColumns (1,8)
'DEFECT CODE in vColumns(1,9)
'REASON FOR REJECTION in vColumns (1,10)
'PRODUCTION WEEK#(1,12)
'COMMENTS in vColumns(1,13)
'CHECK FOR VALID INPUT
If vColumns(1, 2) = "" Then
MsgBox ("DATE, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 3) = "" Then
MsgBox ("CUSTOMER ORDER#, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 4) = "" Then
MsgBox ("DEPARTMENT, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 5) = "" Then
MsgBox ("CLOCK#, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 6) = "" Then
MsgBox ("PART#, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 7) = "" Then
MsgBox ("QUANTITY, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 8) = "" Then
MsgBox ("COLOUR, IS NEEDED TO CONTINUE OR USE N/A")
GoTo CleanUp
ElseIf vColumns(1, 9) = "" Then
MsgBox ("DEFECT CODE, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 10) = "" Then
MsgBox ("REASON FOR REJECTION, IS NEEDED TO CONTINUE")
GoTo CleanUp
ElseIf vColumns(1, 12) = "" Then
MsgBox ("PRODUCTION WEEK#, IS NEEDED TO CONTINUE")
GoTo CleanUp
End If
Set rngHLink = Range("A" & RowToCopy) 'Hyperlink cell
'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 NON CONFORMANCE LOG
'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:="P:\Non-Conformance Log\MRDT Form\MRDT Tag.xlsm")
'SAVE THE ROW VALUES TO PARTICULAR FIELDS IN THE MASTER
With wbSSM.Sheets("MRDT")
.Range("M1").Value = vColumns(1, 1) 'MRDT Number
.Range("A5").Value = vColumns(1, 3) 'CUSTOMER ORDER#
.Range("D5").Value = vColumns(1, 12) 'PRODUCTION WEEK#
.Range("G5").Value = vColumns(1, 4) 'DEPARTMENT
.Range("J5").Value = vColumns(1, 5) 'CLOCK#
.Range("L5").Value = vColumns(1, 2) 'DATE
.Range("A9").Value = vColumns(1, 6) 'PART NUMBER
.Range("D9").Value = vColumns(1, 7) 'QTY
.Range("G9").Value = vColumns(1, 8) 'COLOUR
.Range("A13").Value = vColumns(1, 10) 'REASON FOR REJECTION
.Range("A22").Value = vColumns(1, 20) 'COMMENTS
MsgBox "ADD ANY ADDITIONAL INFORMATION AND PICTURES INTO SQD FORM AND SAVE"
'THIS WORKBOOK IS THE WORKBOOK HOLDING THIS MACRO
strPath = "P:\Non-Conformance Log\2017"
strFile = .Range("M1") & " " & .Range("A9").Value
End With
'THIS SAVES SQD FILE AS FILENAME IN CREATED FOLDER
ActiveWorkbook.SaveAs Filename:=strPath & strFile
'Create Hyperlink
rngHLink.Hyperlinks.Add Anchor:=rngHLink, Address:=strPath
CleanUp:
Set wbSSM = Nothing
End Sub
