I have this code that changes words into hyperlinks, but it can't do it
to other files. So I want the program to be able to open the file it
self and then run the program. I want a message box to pop up to ask
for the file to open, but I want nothing else changed in the code



Code:
--------------------

Sub MakeHyperlink()

ActiveWorksheet.Select
Range("B7").Select
Dim strCellData As Variant

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("G7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("N7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("X7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AG7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AO7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value
Loop

End Sub


--------------------


--
tim64
------------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295
View this thread: http://www.excelforum.com/showthread...hreadid=380674

Backup your workbooks before executing this macro

It will prompt for file, and then opens the workbook,selects Sheet1,
and apply the links to the opened workbook.

Sub MakeHyperlink()
Dim file_open As Variant
Dim org_workbook As Variant
org_workbook = ActiveWorkbook.Name
file_open = Application.GetOpenFilename()

Workbooks.Open Filename:=file_open
Worksheets("Sheet1").Select
Range("B7").Select
Dim strCellData As Variant

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("G7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("N7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("X7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AG7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AO7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

End Sub

End Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=380674

Use GetOpenFilename command built into VBA. You can use this to let the
user select which file the code is going to operate on.
Then use Workbooks.Open to open the selected file.

At the end of your sub use Workbooks.Close

Check the VBA helpfile for more information about using the
GetOpeFilename command.


--
bhofsetz
------------------------------------------------------------------------
bhofsetz's Profile: http://www.excelforum.com/member.php...o&userid=18807
View this thread: http://www.excelforum.com/showthread...hreadid=380674

it doesn't work (see error below )

Sub MakeHyperlink()

Dim file_open As Variant
Dim org_workbook As Variant
org_workbook = ActiveWorkbook.Name
file_open = Application.GetOpenFilename()

Workbooks.Open Filename:=file_open
Range("B7").Select <-------------------------there's a runtime error
here (and mabye in the other range selects)
Dim strCellData As Variant

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("G7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("N7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("X7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AG7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AO7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

End Sub


--
tim64
------------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...o&userid=23295
View this thread: http://www.excelforum.com/showthread...hreadid=380674

What is the exact error messag

--
anilsolipura
-----------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...fo&userid=1627
View this thread: http://www.excelforum.com/showthread.php?threadid=38067