Hello,
I have a workbook with two worksheets in which rows of data are input, each with a reference number. One worksheet is essentially a summary of the second and shows only a few of the columns.
What I need to do is come up with a VBA macro that automatically creates a link between the two worksheets when the data is input. For instance, when I enter the number '1941' in the reference number column in Sheet1, I'd like there to be a hyperlink to the row containing that reference number in Sheet2.
What I am thinking so far is that I would use a macro to search the workbook for the value entered, another function to create the hyperlink based on the value returned by the search macro, and then an overlaying command that would automatically invoke these macros when the sheet is opened or added to.
I have patched together some code from various sources but can't quite figure it out (I'm very new to VBA):
Private Sub Worksheet_Activate() End Sub Sub FindApp() Dim vFind Dim lLoop As Long Dim rFound As Range vFind = ActiveCell On Error Resume Next For lLoop = ActiveSheet.Index + 1 To Sheets.Count With Sheets(lLoop) Set rFound = .UsedRange.Find(What:=vFind, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not rFound Is Nothing Then Application.Goto rFound, True Exit For End If End With Next lLoop End Sub
I've tried various combinations of code to replace the Goto function with, say, "ActiveSheet.Hyperlinks.Add", but I can't get the references to work out (I'm assuming the location is stored in rFound). Anyone have an idea of how to make this work?
Thanks!
Last edited by xlerator; 11-01-2011 at 11:22 AM.
Welcome to the forum!
IF you attach a simple example workbook, we can help more easily. You can manually make one matched hyperlink.
One would generally use a change event for one of the sheets to do it. Since you may have data already, another macro can be used to process the existing data.
Thanks for the response!Originally Posted by Kenneth Hobson
I have attached a sample worksheet with just the reference numbers that need to be linked. Since there will be many data entries, I'd like to have the hyperlinks generated automatically, although I was able to manually one like you suggested.
The first link was done manually and I'd like the rest to be similar but done automatically when new reference numbers are added
Right click sheet1's tab, View Code, and paste:
In a Module paste and run once:Private Sub Worksheet_Change(ByVal Target As Range) Dim f As Range If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub Application.EnableEvents = False Target.Hyperlinks.Delete Set f = Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp)).Find(Target.Value) If Not f Is Nothing Then Sheet1.Hyperlinks.Add Target, "", "Sheet2!" & f.Address Application.EnableEvents = True End Sub
Sub HyperlinkSheet1ColAToSheet2ColA() Dim c As Range, f As Range Application.EnableEvents = False Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp)).Hyperlinks.Delete For Each c In Sheet1.Range("A2", Sheet1.Range("A" & Rows.Count).End(xlUp)) Set f = Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp)).Find(c.Value) If Not f Is Nothing Then Sheet1.Hyperlinks.Add c, "", "Sheet2!" & f.Address Next c Application.EnableEvents = True End Sub
@Kenneth
To improve robustness ?
If Not f Is Nothing Then target.parent.Hyperlinks.Add Target, "", "Sheet2!" & f.Address
OR:
If Not f Is Nothing Then ActiveSheet.Hyperlinks.Add Target, "", "Sheet2!" & f.Address
or
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub on error resume next Target.Hyperlinks.Delete Hyperlinks.Add Target, "", "Sheet2!" & Sheet2.columns(1),Find(Target.Value,,xlvalues,xlwhole).Address End Sub
Thanks, this worked beautifully!
Now, I am applying this code to another workbook and am having a little trouble. This workbook has the same setup, but instead of going from Sheet1 Col A to Sheet2 Col A, the links are from Sheet4 Col A to Sheet2 Col F.
I have made the following adjustments to the code, which result in an "Invalid Reference" error when I click the hyperlinks (the changes are bolded):
Worksheet Code:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub On Error Resume Next Target.Hyperlinks.Delete Hyperlinks.Add Target, "", "Sheet2!" & Sheet2.Columns(5), Find(Target.Value, , xlValues, xlWhole).Address End Sub
Module Code:
Sub HyperlinkSheet4ColAToSheet2ColF() Dim c As Range, f As Range Application.EnableEvents = False Sheet4.Range("A2", Sheet4.Range("A" & Rows.Count).End(xlUp)).Hyperlinks.Delete For Each c In Sheet4.Range("A2", Sheet4.Range("A" & Rows.Count).End(xlUp)) Set f = Sheet2.Range("F2", Sheet2.Range("F" & Rows.Count).End(xlUp)).Find(c.Value) If Not f Is Nothing Then Sheet4.Hyperlinks.Add c, "", "Sheet2!" & f.Address Next c Application.EnableEvents = True End Sub
The Module change is probably ok. The worksheet code should be changed to Sheet4 as well.
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub On Error Resume Next Target.Hyperlinks.Delete Hyperlinks.Add Target, "", "Sheet4!" & Sheet4.Columns(5), Find(Target.Value, , xlValues, xlWhole).Address End Sub
Hmmm, I'm getting the same error after changing the code you suggested. However, when I hover over the hyperlink it appears to point to the correct row/column in the other sheet. Any other thoughts?
please see the file and can u make it Coloumn D, E,F to be generated automatically..if i apply to any where..u can see the format that i want for D,E,F coloumn Cells.. please observe only two condtions for max and min and difference between the cells..i have made with simple logic...so i need a common fucntions..to run any lengthy data..please..
Last edited by jayaram; 10-31-2011 at 09:18 PM.
Yes, only 3
- do not quote (see the forum rules)
- post a sample workbook
- I doubt the correctness of the codenames you applied (you know the difference bewteen codenames & names in VBA ?)
jayaram,
Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread.
“To sin by silence when they should protest makes cowards of men.” ~ Abraham Lincoln
I realized that the reason I'm getting the Reference errors is because I used sheet CodeNames in all the VBA code. Sheets 2 and 4 have different tab names, so I have to substitute those in.
Is this the correct implementation of sheet names?:
andPrivate Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub On Error Resume Next Target.Hyperlinks.Delete Hyperlinks.Add Target, "", "WorkSheets("Data Sheet 2")!" & WorkSheets("Data Sheet 2").Columns(5), Find(Target.Value, , xlValues, xlWhole).Address End Sub
Sub HyperlinkSheet4ColAToSheet2ColF() Dim c As Range, f As Range Application.EnableEvents = False WorkSheets("Data Sheet 4").Range("A2", WorkSheets("Data Sheet 4").Range("A" & Rows.Count).End(xlUp)).Hyperlinks.Delete For Each c In WorkSheets("Data Sheet 4").Range("A2", WorkSheets("Data Sheet 4").Range("A" & Rows.Count).End(xlUp)) Set f = WorkSheets("Data Sheet 2").Range("F2", WorkSheets("Data Sheet 2").Range("F" & Rows.Count).End(xlUp)).Find(c.Value) If Not f Is Nothing Then WorkSheets("Data Sheet 4").Hyperlinks.Add c, "", "WorkSheets("Data Sheet 4")!" & f.Address Next c Application.EnableEvents = True End Sub
I don't think so:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub On Error Resume Next Hyperlinks.Add Target, "", "#'Data Sheet 2'!" & sheets("Data Sheet 2").Columns(5).Find(Target.Value, , xlValues, xlWhole).Address(,,,true) End Sub
Last edited by snb; 11-01-2011 at 11:20 AM.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Reply With Quote
Bookmarks