VB Generated Hyperlinks

A

AU_BTS

My need is this; I have a master spreadsheet with Column A being a list of
9 character control numbers which are text entries for hyperlinks to another
folder filled with Excel spreadsheets, whose first nine characters are the
control numbers matched in the master Spreadsheet. What I would like is an
update spreadsheet button; not a new toolbar button, on the master
spreadsheet that will tell excel to go look in a specified folder, it will
always be the same folder, check to see if there are any files in the folder
which are not on the master spreadsheet already. If there are new files
create a new hyperlink; titled with the first nine characters of the file
name in the next available cell in Coloumn A. When it is done updating a
little window saying how many entries were created or if none were created
would be nice, but not neccessary.
I am not a VB programmer by anymeans and my Excel formula skills are
moderate, so any help with this would be greatly appreciated, thank you.
 
A

AU_BTS

This is the program I am working from. Probably longer than it needs to be ,
but it works for getting the files read and added. Really all I am missing
is how to do the hyperlink part.

***************************************************
Private Sub CommandButton1_Click()
Dim Directory As String
Dim FileName As String
Dim IndexSheet As Worksheet
Dim rw As Long
Dim wSht As Worksheet
Dim TaskerName As String
Dim Dup As Integer

Set topcel = Range("A3")
Set bottomCel = Cells((65536), topcel.Column).End(xlUp)

Application.ScreenUpdating = False

'Change the directory below as needed
ChDir _<>

If Left(Directory, 1) <> "\" Then
Directory = Directory & "\"
End If

rw = 3

Set IndexSheet = ThisWorkbook.ActiveSheet

FileName = Dir(Directory & "*.xls")
Do While FileName <> ""

IndexSheet.Cells(rw, 53).Value = FileName
rw = rw + 1
FileName = Dir
Loop

Set IndexSheet = Nothing

Set xtopcel = Range("BA3")
Set xbottomcel = Cells((65536), xtopcel.Column).End(xlUp)

Range("A2").Activate

Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

For x = 3 To xbottomcel.Row
Dup = 1
TaskerName = ActiveSheet.Cells(x, 52).Value

For y = 3 To bottomCel.Row
If TaskerName = ActiveSheet.Cells(y, 1).Value Then
Dup = 2

End If
Next y

If Dup = 1 Then
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop

ActiveCell = TaskerName
End If
Next x

Range(xtopcel, xbottomcel).Select
Selection.ClearContents

Range("A2").Activate

Application.ScreenUpdating = True

End Sub
***************************************************
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top