opening a file

T

tim64

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
 
A

anilsolipuram

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
 
B

bhofsetz

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.
 
T

tim64

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
 
A

anilsolipuram

test this , i shortened the macro for testing purpose

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("g7").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

end sub
 
T

tim64

it's the same error

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("g7").Select <----------------------- it errors here
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
 
A

anilsolipuram

let me know what message pops up
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
msgbox file_open
Range("g7").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

end sub
 
T

tim64

the first meesage says C:\working\project_test.xls

then theres the error message:

Run-time error '1004':
Application-defined or Object-defined error
 
A

anilsolipuram

I am not sure what is the error, it is working good for me.

I added one more debug, popups up the g7 cell value, let me know

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
msgbox file_open
msgbox Range("g7").value
Range("g7").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

end sub
 
A

anilsolipuram

I am not siure why command for selecting cell is not working, use
alternate selecting method like cells(7,7).select (which is selectin
g7)

try this macro now

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
msgbox file_open
msgbox cells(7,7).value
cells(7,7).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

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

Similar Threads

opening a folder then creating links 15
hyperlinking to charts in file 1
Insert Hyperlink 4
add hyperlink using sheet names and cells(i,j) 3
Hyperlink macro for personal.xls 4
Hyperlinking cells and macros 2
Opening New Work with Wedpage Content when address is in original workbook 5
VBA - Hyperlink Function Combined with Find 6

Top