Using userform to add hyperlink

PuntingJawa

PuntingJawa

Board Regular
Joined
Feb 25, 2021
Messages
140
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
I'm looking to add to my userform the function of adding a hyperlink. It looks like the image below.
1665774902557.png

I've been experimenting but haven't come up with anything functional at all. What I am attempting to do is when I enter in "Pack File Name" and enter the filepath to "Pack File Link" that it creates a hyperlink into "Range("N" & erow + 1)" with the pack file name. Per usual, I believe that I am overcomplicating in my attempts.
VBA Code: 
'Private Sub PackFileLink_Change()
'File location for hyperlink
'End Sub

'Private Sub PackFileName_Change()
'File name
'End Sub

Private Sub RecDate_Change() 'Date

End Sub

Private Sub RecNCR_Change()
    RecNCR.Text = UCase(RecNCR.Text) 'NCR #
End Sub

Private Sub RecRMA_Change()
    RecRMA.Text = UCase(RecRMA.Text) 'RMA #
End Sub

Private Sub RecSupplier_Change()
    RecSupplier.Text = UCase(RecSupplier.Text) 'Supplier
End Sub

Private Sub RecProject_Change()
    RecProject.Text = UCase(RecProject.Text) 'Project #
End Sub

Private Sub RecDescription_Change()
    RecDescription.Text = UCase(RecDescription.Text) 'Item Description
End Sub

Private Sub RecPartNumber_Change()
    RecPartNumber.Text = UCase(RecPartNumber.Text) 'Part #
End Sub

Private Sub RecSlipQTY_Change()
    RecSlipQTY.Text = UCase(RecSlipQTY.Text) 'QTY on packing slip
End Sub

Private Sub RecCountQTY_Change()
    RecCountQTY.Text = UCase(RecCountQTY.Text) 'Actual QTY count
End Sub

Private Sub RecPackNumber_Change()
    RecPackNumber.Text = UCase(RecPackNumber.Text) 'Packing Slip #
End Sub

Private Sub RecPO_Change()
    RecPO.Text = UCase(RecPO.Text) 'PO #
End Sub

Private Sub UserForm_Activate()

RecDate.Text = Format(Now(), "MM/DD/YY") 'Auto date for today


End Sub
Private Sub ReceivingSubmit_Click() 'Command button submit

erow = Sheets("Receiving").Range("a" & Rows.Count).End(xlUp).Row 'Submit on next open "A" row
    Range("A" & erow + 1) = RecDate.Value 'Date
    Range("B" & erow + 1) = RecSupplier.Value 'Supplier
    Range("C" & erow + 1) = RecProject.Value 'Project #
    Range("D" & erow + 1) = RecDescription.Value 'Decription
    Range("E" & erow + 1) = RecPartNumber.Value 'Part #
    Range("F" & erow + 1) = RecSlipQTY.Value 'Packing slip QTY
    Range("G" & erow + 1) = RecCountQTY.Value 'Actual count QTY
    Range("I" & erow + 1) = "PS " & RecPackNumber.Value 'Pack Slip #
    Range("J" & erow + 1) = "PO " & RecPO.Value 'Purchase Order #
    Range("K" & erow + 1) = RecNCR.Value 'NCR #
    Range("L" & erow + 1) = RecRMA.Value 'RMA #
    ThisWorkbook.Save

End Sub

Private Sub ReceivingClear_Click()
    RecSupplier.Value = "" 'Supplier
    RecProject.Value = "" 'Project #
    RecDescription.Value = "" 'Decription
    RecPartNumber.Value = "" 'Part #
    RecSlipQTY.Value = "" 'Packing slip QTY
    RecCountQTY.Value = "" 'Actual count QTY
    RecPackNumber.Value = "" 'Pack Slip #
    RecPO.Value = "" 'Purchase Order #
    RecNCR.Value = "" 'NCR #
    RecRMA.Value = "" 'RMA #

End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
HI. How about the the following? The idea is that this will replace the current ReceivingSubmit_Click code.

VBA Code: 
Private Sub ReceivingSubmit_Click() 'Command button submit
    Dim WS As Worksheet
    Dim ERow As Long
    Set WS = Application.ThisWorkbook.Sheets("Receiving")
    ERow = WS.Range("a" & Rows.Count).End(xlUp).Row + 1 'Submit on next open "A" row
    
    With WS
        .Range("A" & ERow) = RecDate.value  'Date
        .Range("B" & ERow) = RecSupplier.value  'Supplier
        .Range("C" & ERow) = RecProject.value  'Project #
        .Range("D" & ERow) = RecDescription.value  'Decription
        .Range("E" & ERow) = RecPartNumber.value  'Part #
        .Range("F" & ERow) = RecSlipQTY.value  'Packing slip QTY
        .Range("G" & ERow) = RecCountQTY.value  'Actual count QTY
        .Range("I" & ERow) = "PS " & RecPackNumber.value  'Pack Slip #
        .Range("J" & ERow) = "PO " & RecPO.value  'Purchase Order #
        .Range("K" & ERow) = RecNCR.value  'NCR #
        .Range("L" & ERow) = RecRMA.value  'RMA #
        .Hyperlinks.Add Anchor:=.Range("N" & ERow), Address:=PackFileLink.Text, TextToDisplay:=PackFileName.Text
    End With
    
    ThisWorkbook.Save

End Sub
It creates a hyperlink in the same row, column N (as requested), using the Text PackFilename as the Display Text.
 
Upvote 0
Solution
Dan_W said:
HI. How about the the following? The idea is that this will replace the current ReceivingSubmit_Click code.

VBA Code: 
Private Sub ReceivingSubmit_Click() 'Command button submit
    Dim WS As Worksheet
    Dim ERow As Long
    Set WS = Application.ThisWorkbook.Sheets("Receiving")
    ERow = WS.Range("a" & Rows.Count).End(xlUp).Row + 1 'Submit on next open "A" row
   
    With WS
        .Range("A" & ERow) = RecDate.value  'Date
        .Range("B" & ERow) = RecSupplier.value  'Supplier
        .Range("C" & ERow) = RecProject.value  'Project #
        .Range("D" & ERow) = RecDescription.value  'Decription
        .Range("E" & ERow) = RecPartNumber.value  'Part #
        .Range("F" & ERow) = RecSlipQTY.value  'Packing slip QTY
        .Range("G" & ERow) = RecCountQTY.value  'Actual count QTY
        .Range("I" & ERow) = "PS " & RecPackNumber.value  'Pack Slip #
        .Range("J" & ERow) = "PO " & RecPO.value  'Purchase Order #
        .Range("K" & ERow) = RecNCR.value  'NCR #
        .Range("L" & ERow) = RecRMA.value  'RMA #
        .Hyperlinks.Add Anchor:=.Range("N" & ERow), Address:=PackFileLink.Text, TextToDisplay:=PackFileName.Text
    End With
   
    ThisWorkbook.Save

End Sub
It creates a hyperlink in the same row, column N (as requested), using the Text PackFilename as the Display Text.
Click to expand...
Thank you very much. I can work with this. I simplified it by replacing "PackFileName.text" with "RecPackNumber.text" since I plan on saving with the same name as the packing slip number. Thank you very much!
 
Upvote 0
I thought of a way to simplify this even further. If I want to keep the folder static but have the "RecPackNumber.text" like I mentioned above but linked to a PDF, how would I go about doing that?

Example:
If the permanent folder were
"K:\1 - Shipping receiving\Packing Slips\"
and the file name were
"20221102-1"
How would I get this to hyperlink as the following?
K:\1 - Shipping receiving\Packing Slips\20221102-1.pdf

The biggest issue I am having is figuring out how to format the link itself to a PDF.
 
Upvote 0
PuntingJawa said:
If the permanent folder were
"K:\1 - Shipping receiving\Packing Slips\"
and the file name were
"20221102-1"
How would I get this to hyperlink as the following?
K:\1 - Shipping receiving\Packing Slips\20221102-1.pdf

The biggest issue I am having is figuring out how to format the link itself to a PDF.
Click to expand...
I'm still trying to wrap my head around coding but I am getting better in my understanding.
Based on my above inquiry, Does the below VBA code look correct or is there a simpler format that I am overlooking?

VBA Code: 
        .Hyperlinks.Add Anchor:=.Range("N" & ERow), Address:=K:\1 - Shipping receiving\Packing Slips\&PackFileName.text&"*.pdf", TextToDisplay:=PackFileName.Text
 
Upvote 0
Hi - sorry - so if I understand you correctly, basically you just want to tack on the filename (which is some kind of PDF with a name like "20221102-1") onto a base folder path that won't be changing?
If that's the case, lets set up the path as a constant at the outset of the code. At the top part of the module, put:

VBA Code: 
Const FOLDERPATH As String = "K:\1 - Shipping receiving\Packing Slips\"

Then let's declare a variable to store the filename at the start of the procedure with:
VBA Code: 
Dim FullFilePath As String

So it looks something like:

VBA Code: 
Private Sub ReceivingSubmit_Click()
    Dim WS As Worksheet
    Dim ERow As Long
    Dim FullFilePath As String

....

and then we can build the full file path just before setting the hyperlink with:
VBA Code: 
        FullFilePath = FOLDERPATH & PackFileName.Text & ".PDF"
        .Hyperlinks.Add Anchor:=.Range("N" & ERow), Address:=FullFilePath, TextToDisplay:=PackFileName.Text

Does that make sense? Let me know if it doesn't and I'll give my explanation a rethink. I assumed you've changed the code a bit since we first spoke, so you'll have to adjust the above to make sure it makes sense with what you currently have.
 
Upvote 0
Dan_W said:
Hi - sorry - so if I understand you correctly, basically you just want to tack on the filename (which is some kind of PDF with a name like "20221102-1") onto a base folder path that won't be changing?
If that's the case, lets set up the path as a constant at the outset of the code. At the top part of the module, put:

VBA Code: 
Const FOLDERPATH As String = "K:\1 - Shipping receiving\Packing Slips\"

Then let's declare a variable to store the filename at the start of the procedure with:
VBA Code: 
Dim FullFilePath As String

So it looks something like:

VBA Code: 
Private Sub ReceivingSubmit_Click()
    Dim WS As Worksheet
    Dim ERow As Long
    Dim FullFilePath As String

....

and then we can build the full file path just before setting the hyperlink with:
VBA Code: 
        FullFilePath = FOLDERPATH & PackFileName.Text & ".PDF"
        .Hyperlinks.Add Anchor:=.Range("N" & ERow), Address:=FullFilePath, TextToDisplay:=PackFileName.Text

Does that make sense? Let me know if it doesn't and I'll give my explanation a rethink. I assumed you've changed the code a bit since we first spoke, so you'll have to adjust the above to make sure it makes sense with what you currently have.
Click to expand...
I haven't changed anything in the code since. I made a separate file to play around in as to not mess up any of the current working code.

Should it look like this?
VBA Code: 
Private Sub ReceivingSubmit_Click() 'Command button submit
    Dim WS As Worksheet
    Dim ERow As Long
    Set WS = Application.ThisWorkbook.Sheets("Receiving")
    ERow = WS.Range("a" & Rows.Count).End(xlUp).Row + 1 'Submit on next open "A" row
    Const FOLDERPATH As String = "K:\1 - Shipping receiving\Packing Slips\"
    With WS
        .Range("A" & ERow) = RecDate.value  'Date
        .Range("B" & ERow) = RecSupplier.value  'Supplier
        .Range("C" & ERow) = RecProject.value  'Project #
        .Range("D" & ERow) = RecDescription.value  'Decription
        .Range("E" & ERow) = RecPartNumber.value  'Part #
        .Range("F" & ERow) = RecSlipQTY.value  'Packing slip QTY
        .Range("G" & ERow) = RecCountQTY.value  'Actual count QTY
        .Range("I" & ERow) = "PS " & RecPackNumber.value  'Pack Slip #
        .Range("J" & ERow) = "PO " & RecPO.value  'Purchase Order #
        .Range("K" & ERow) = RecNCR.value  'NCR #
        .Range("L" & ERow) = RecRMA.value  'RMA #
        FullFilePath = FOLDERPATH & PackFileName.Text & ".PDF"
        .Hyperlinks.Add Anchor:=.Range("N" & ERow), Address:=FullFilePath, TextToDisplay:=PackFileName.Text
    End With
    
    ThisWorkbook.Save
 
Upvote 0
Well, I would've put the Const line at the very top, but it can stay there I guess. Also, you're missing this line, no:
VBA Code: 
Dim FullFilePath As String
Put that after the Const line, and let me know how it goes.
 
Upvote 0
It throws an error at
VBA Code: 
Set WS = Application.ThisWorkbook.Sheets("Receiving")
I set it up like suggested
VBA Code: 
Private Sub ReceivingSubmit_Click() 'Command button submit
    Const FOLDERPATH As String = "K:\1 - Production\Shipping receiving\Packing Slips\"
    Dim FullFilePath As String
    Dim WS As Worksheet
    Dim ERow As Long
    Set WS = Application.ThisWorkbook.Sheets("Receiving")
    ERow = WS.Range("a" & Rows.Count).End(xlUp).Row + 1 'Submit on next open "A" row
    With WS
        .Range("A" & ERow) = RecDate.Value  'Date
        .Range("B" & ERow) = RecSupplier.Value  'Supplier
        .Range("C" & ERow) = RecProject.Value  'Project #
        .Range("D" & ERow) = RecDescription.Value  'Decription
        .Range("E" & ERow) = RecPartNumber.Value  'Part #
        .Range("F" & ERow) = RecSlipQTY.Value  'Packing slip QTY
        .Range("G" & ERow) = RecCountQTY.Value  'Actual count QTY
        .Range("I" & ERow) = "PS " & RecPackNumber.Value  'Pack Slip #
        .Range("J" & ERow) = "PO " & RecPO.Value  'Purchase Order #
        .Range("K" & ERow) = RecNCR.Value  'NCR #
        .Range("L" & ERow) = RecRMA.Value  'RMA #
        FullFilePath = FOLDERPATH & PackFileName.Text & ".PDF"
        .Hyperlinks.Add Anchor:=.Range("N" & ERow), Address:=FullFilePath, TextToDisplay:=PackFileName.Text
    End With
    
    ThisWorkbook.Save
End Sub
 
Upvote 0
PuntingJawa said:
Set WS = Application.ThisWorkbook.Sheets("Receiving")
Click to expand...
Well if that's where it's throwing an error, that would suggest that perhaps you don't have a worksheet called Receiving in that workbook? What's the error number and the error message?
 
Upvote 0
You must log in or register to reply here.

Similar threads

PuntingJawa
  • Solved
Save file after pressing button in userform
Replies
2
Views
225
PuntingJawa
PuntingJawa
PuntingJawa
  • Solved
Multiple Userform One works the other not
2
Replies
19
Views
737
Jon Peltier
J
PuntingJawa
  • Solved
Receiving log Userform adding text before submission
Replies
3
Views
381
Logit
Logit
J
  • Solved
Add a hyperlink and display click here to open
Replies
3
Views
427
Domenic
D
X
  • Solved
Add Conditional Formatting to a Hyperlink
Replies
4
Views
577
XrayLemi
X

Forum statistics

Threads
1,215,050
Messages
6,122,868
Members
449,097
Latest member
dbomb1414

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top