Macro/Merge Columns Solution

[bflan0524]

hello, i was looking for help, not sure if this would be a macro or something else that would be able to do this

Example i have two columns

Column A Company Name
Joe Smith Sports
John Doe INC

Column B Company Link
www.joesmithsports.com
www.johndoeinc.com

is there a way to merge the two columns into one, so the text to display would be the company name but its really a link which is invisible to the user. i know you can do this through hyperlink, but these columns would have thousands of data points

 

[cooper645]

Not sure exactly what you mean, but I have come up with the following vba code.

It starts at cell B1 with the web link,
Applies the Name in Column A as the text to display,

Column B now reads the same as column A, but is in fact a hyperlink,

The code in red will delete column A after creating all the hyperlinks.
Remove this line if you need to keep them.

​The code in blue will simply hide column A rather than delete it.

Sub create_links()
Dim i As Long
For i = 1 To Range("B1").CurrentRegion.Rows.Count
Cells(i, 2).Select
Selection.Hyperlinks(1).TextToDisplay = Cells(i, 1).Value
Next i
[COLOR=#ff0000]Range("A:A").EntireColumn.Delete
[/COLOR][COLOR=#0000ff][/COLOR][COLOR=#0000ff][/COLOR][COLOR=#0000ff]Range("A:A").EntireColumn.Hidden = True[/COLOR]
End Sub

Test this on a blank workbook with a few example names and links to see if it is what you need first. always back up your work before running macros.


Hope this helps,

Coops

 

[bflan0524]

hello
thank you for your feedback, when i do this i get run time error 9, subscript out of range

 

[cooper645]

I would imagine that your first link is not in cell B1.

the two number 1s in green and underlined, change these to the first row number that contains a hyperlink

also, which case are you using, do you need to delete column A afterwards or simply hide it?

Sub create_links()
Dim i As Long
For i = [U][B][COLOR=#008000]1[/COLOR][/B][/U] To Range("B[B][U][COLOR=#008000]1[/COLOR][/U][/B]").CurrentRegion.Rows.Count + i 
Cells(i, 2).Select
Selection.Hyperlinks(1).TextToDisplay = Cells(i, 1).Value
Next i
[COLOR=#ff0000]Range("A:A").EntireColumn.Delete
[/COLOR][COLOR=#0000ff]Range("A:A").EntireColumn.Hidden = True[/COLOR]
End Sub

 

[bflan0524]

ah that makes sense, ty
i am using the hide column option

 

[bflan0524]

that worked, thank you
can you break down for me what the query does by chance? i like to learn that too as opposed to just copy and paste
also one more quick question, i ran it by going to view, macros, run
if this macro was in a workbook i am using and when i opened the workbook and enabled macros, would it automatically perform this function?

 

[cooper645]

If you change the Sub name as below and place it in the "ThisWorkbook" code rather than a module of its own, it should run each time the workbook is opened.

Sub Workbook_Open()
Dim i As Long
For i = [U][B][COLOR=#008000]1[/COLOR][/B][/U] To Range("B[B][U][COLOR=#008000]1[/COLOR][/U][/B]").CurrentRegion.Rows.Count + i 
Cells(i, 2).Select
Selection.Hyperlinks(1).TextToDisplay = Cells(i, 1).Value
Next i[COLOR=#ff0000]
[/COLOR]Range("A:A").EntireColumn.Hidden = True
End Sub

 

[cooper645]

Sub Workbook_Open() -This is the sub name Workbook_Open will cause it to trigger on workbook opening if in the right place


Dim i As Long - Declare that i will be an integer up to a large value


For i = 1 To Range("B1").CurrentRegion.Rows.Count + i - For i to be value 1, through to (B1 and however many rows below data goes) + the value of i to account for the blank rows above


Cells(i, 2).Select - select cell at (row i , column 2(B))


Selection.Hyperlinks(1).TextToDisplay = Cells(i, 1).Value - take the hyperlink at that cell and make the text to display = row i, column 1(A)
Next i - Now move to the next i and loop through, ie, the next row number, so second time i=2, then 3rd i=3 and so on until we reach the number of rows found at the start with the current region part.


Range("A:A").EntireColumn.Hidden = True - hide column A


End Sub - End the Sub routine

 

[bflan0524]

thank you so much i greatly appreciate it

 

[cooper645]

no problem, let us know if you have any further problems.