I have this code that converts web addresses into links in this file
that is created in another program. The problem is I have to copy the
code form where it is and then paste it in the file's, with the links,
VBE area. What I want is a message box to pop up so I can choose the
file, with the links, and then it copies and pastes the code
automaticly, then it runs the code.



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

Sub MakeHyperlink()

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

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select
On Error Resume Next
'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
On Error Resume Next
'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
On Error Resume Next
'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
On Error Resume Next
'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
On Error Resume Next
'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
On Error Resume Next
'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=383192

Backup your workbook before trying this macro.

I condensed the code,

range_copy is the range to be copied from, copy_to is the locatio
where it will be copied


Sub MakeHyperlink()
Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant
v = Array("b", "G", "n""x", "ag", "ao")
range_copy = "b7:az30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename
Workbooks.Open Filename:=file_name
n_file = ActiveWorkbook.Name
Range(range_copy).Select
Selection.Copy
Workbooks(o_file).Activate
Range(copy_to).Select
ActiveSheet.Paste
Workbooks(n_file).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks(o_file).Activate
For i = 0 To UBound(v)
Range(v(i) & "7").Select
Do Until ActiveCell.Value = ""
strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select
On Error Resume Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\
& Selection.Value, TextToDisplay:=Selection.Value
Loop
Next
End Su

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

there's an error (see below)


Sub MakeHyperlink()
Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant
v = Array("b", "G", "n""x", "ag", "ao")
range_copy = "b7:az30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename
Workbooks.Open Filename:=file_name <----------- run time error '1004'
n_file = ActiveWorkbook.Name
Range(range_copy).Select
Selection.Copy
Workbooks(o_file).Activate
Range(copy_to).Select
ActiveSheet.Paste
Workbooks(n_file).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks(o_file).Activate
For i = 0 To UBound(v)
Range(v(i) & "7").Select
Do Until ActiveCell.Value = ""
strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select
On Error Resume Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\"
Selection.Value, TextToDisplay:=Selection.Value
Loop
Next
End Su

--
tim6
-----------------------------------------------------------------------
tim64's Profile: http://www.excelforum.com/member.php...fo&userid=2329
View this thread: http://www.excelforum.com/showthread.php?threadid=38319

Try this macro, and type in the error that popsup


Sub MakeHyperlink()
Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant
v = Array("b", "G", "n", "x", "ag", "ao")
range_copy = "b7:az30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename

If file_name < "" Then
On Error GoTo a:
Workbooks.Open Filename:=file_name
n_file = ActiveWorkbook.Name
Range(range_copy).Select
Selection.Copy
Workbooks(o_file).Activate
Range(copy_to).Select
ActiveSheet.Paste
Workbooks(n_file).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks(o_file).Activate
For i = 0 To UBound(v)
Range(v(i) & "7").Select
Do Until ActiveCell.Value = ""
strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select
On Error Resume Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection
Address:="http:\\" & Selection.Value, TextToDisplay:=Selection.Value
Loop
Next
End If
a:
MsgBox Err.Description
End Su

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

the MsgBox said "select method of range class failed "

Sub MakeHyperlink()
Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant
v = Array("b", "G", "n", "x", "ag", "ao")
range_copy = "b7:az30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename

If file_name < "" Then
On Error GoTo a:
Workbooks.Open Filename:=file_name
n_file = ActiveWorkbook.Name
Range(range_copy).Select <-------- it errors here
Selection.Copy
Workbooks(o_file).Activate
Range(copy_to).Select
ActiveSheet.Paste
Workbooks(n_file).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks(o_file).Activate
For i = 0 To UBound(v)
Range(v(i) & "7").Select
Do Until ActiveCell.Value = ""
strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select
On Error Resume Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop
Next
End If
a:
MsgBox Err.Description
End Sub


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

now, what all msgs popsup

Sub MakeHyperlink()
Dim v, file_name, o_file, n_file, range_copy, copy_to As Variant
v = Array("b", "G", "n", "x", "ag", "ao")
range_copy = "b7:az30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename

If file_name < "" Then
On Error GoTo a:
Workbooks.Open Filename:=file_name
n_file = ActiveWorkbook.Name
msgbox range_copy
Range(range_copy).Select
Selection.Copy
Workbooks(o_file).Activate
Range(copy_to).Select
ActiveSheet.Paste
Workbooks(n_file).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks(o_file).Activate
For i = 0 To UBound(v)
Range(v(i) & "7").Select
Do Until ActiveCell.Value = ""
strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select
On Error Resume Next
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop
Next
End If
a:
MsgBox Err.Description
End Sub


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