opening a folder then creating links

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.

Please Login or Register  to view this content.

Backup your workbook before trying this macro.

I condensed the code,

range_copy is the range to be copied from, copy_to is the location 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 Sub

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 Sub

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 Sub

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

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

the first one is "b7:az30"
the second one is "select method of range class failed "

I changed the range_copy, let me know wha 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 = "d10:d30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename

If file_name <> "" Then
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

End Sub

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 = "d10:d30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename

If file_name <> "" Then
Workbooks.Open Filename:=file_name
n_file = ActiveWorkbook.Name
MsgBox range_copy <------- d10:d30
Range(range_copy).Select <----------- run time error '1004'
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

End Sub

It is working fine for me , i am not sure why it is not working for you. Try this and let me know what popups


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 = "a10:a30"
copy_to = "b7"
o_file = ActiveWorkbook.Name
file_name = Application.GetOpenFilename

If file_name <> "" Then
Workbooks.Open Filename:=file_name
n_file = ActiveWorkbook.Name
MsgBox range_copy
msgbox Range(cstr(range_copy)).address
Range(cstr(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

End Sub

first a10:a30
second $A$10:$A$30
third run time error '1004'

Trying opening different file

does the same thing

I am guessing probably the file you are opening is worksheet protected or the some the are merged .

I want you create the new file add save it in c:\, and then test the macro I sent you , now open the new_created file when file dialog comes up.

does the same thing

that wasn't the problem