Macro capable of Picking Random PDF files in a hyperlink, and or save them in a specific file.

Brass Contributor

Ok... so here is my question/problem.  I have a folder that has let's say 100 different PDF's for safety training.  We need to give them out at the beginning of each day, of each job.  The "safety talks" need to be different each time.   I found a cool little macro for excel that can auto generate a random list of file names based on a number entered.  10 days, it gives me 10 random names.  2 days, two random names, etc..., however, I want to do one better.  I would like the list it populates to hyperlink to the actual file, and or auto save that specific PDF in another folder.  Right now, the list works fine, but I have to search in the folder for the specific PDF files.  If I make my list all hyperlinks, the name carries over, but not the link.  Is it possible to make my random list, auto update to links?

 

Here is the code I found, and a link to the video of it working. 

www.youtube.com/watch?v=vgr9rDw1sRQ

Sub PickNamesAtRandom()
Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names() As String 'Array to store randomly selected names
Dim i As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes
Application.ScreenUpdating = False
HowMany = Range("D3").Value
CellsOut = 6
ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("A:A")) - 1 ' Find how many names in the list
i = 1
Do While i <= HowMany
RandomNo:
RandomNumber = Application.RandBetween(2, NoOfNames + 1)
'Check to see if the name has already been picked
For ArI = LBound(Names) To UBound(Names)
If Names(ArI) = Cells(RandomNumber, 1).Value Then
GoTo RandomNo
End If
Next ArI
Names(i) = Cells(RandomNumber, 1).Value ' Assign random name to the array
i = i + 1
Loop
'Loop through the array and enter names onto the worksheet
For ArI = LBound(Names) To UBound(Names)
Cells(CellsOut, 4) = Names(ArI)
CellsOut = CellsOut + 1
Next ArI
Application.ScreenUpdating = True
End Sub

1 Reply

@Budman361530 

Do the names in column A include the path? If so, change the line

 

Cells(CellsOut, 4) = Names(ArI)

 

to

 

ActiveSheet.Hyperlinks.Add Anchor:=Cells(CellsOut, 4), Address:=Names(Arl)

 

If they do not include the path, use

 

ActiveSheet.Hyperlinks.Add Anchor:=Cells(CellsOut, 4), Address:="C:\Folder\Subfolder\" & Names(Arl), TextToDisplay:=Names(Arl)

 

where C:\Folder\Subfolder is the path.