Click cell Col i Sheet 1 to create hyperlink to Col J Sheet 2 where dates in sheets match

[Ironman]

Hi

I'm looking for some code that will run only when I double click a cell in sheet 'Training Log' column i cells 7322 to 23357 that begins with the text "Indoor bike session" (without the commas).

When I double click the cell, the code searches Col A rows 11 onwards of sheet 'Indoor Bike' for the same date and when found, creates a link to Col J in that row, in Col i of sheet Training Log and retains the same text "Indoor bike session..." as before, with a tooltip "Go to Indoor Bike entry for (+ the relevant date)".

The code should only run once for each of the relevant cells i.e. it should only function as a link once the link has been created.

I hope the below extracts showing Indoor Bike sessions in blue with the same dates in both sheets make this reasonably clear.

A solution would be greatly appreciated.

Many thanks!


Sheet 'Training Log' extract

Copy of Exercise Log for MrExcel posts.xlsx
	A	B	C	D	E	F	G	H	I
8666	Sat, 11 Sep 2021	OTHER				111	69%	J	Indoor bike session, 60 mins.
8667	Sun, 12 Sep 2021	REST					0%		Well earned.
8668	Mon, 13 Sep 2021	OTHER				116	72%	J	Indoor bike session, 60 mins.
8669	Tue, 14 Sep 2021	Hallas Br/Down Bents Ln Harden Lane/Smithy Ln/ Lee Farm/Black Hills/ Golf Course/R down Beck Foot Lane/Wagon Lane/ Down LLC to Shipley (Over Dock Ln to post) Back, past 5-Rise Locks to 2nd road junction (Duck House)/Back down to 3-Rise & over Br/ Brown Cow/Main Rd all the way back home	17.1	4:13:19	14:49	116	72%	J	Day 5537. 1:15pm, 13ºC, light rain most of the way round, quite nice. Phone app said heavy rain (took heed as it was eventually right about the deluge the other week) but thankfully it got it wrong as it was only ever light drizzle. Wore old yellow Goretex jacket + t-shirt, loads of vaseline on right nipple (and fingers), no problem (even though t-shirt was drenched when I took it off after). Porage oats and milk + 2pts squash 30 mins+ B4 leaving. No water taken. Pee stop at wall of field B4 approach to Blackhills. Heart felt bit strained for first 45 mins and bit concerned about ave HR of 114bpm on watch (it reduced once I was on the canal). It was probably cos of broken sleep - in bed 2am then getting up for a wee at least 3 times in the night. Head VERY tired along canal towards Shipley and back towards Dowley Gap, could have just gone to sleep although heart/legs were OK, but familiarity then made me feel better beyond there for rest of the run. Backache didn't set in until Bingley this time but bit worried about slight spasms in L calf muscle, although thankfully it never got any worse. L hamstring became tight but as ever but it didn't affect my gait. Had it in mind from the start I wanted to exceed 4hrs and by 5-Rise Locks I felt confident enough to keep going to the Duck House (2nd road junction). When I got back to the 5-Rise I calculated I was on for about 4hrs 10mins. Although I started to get v thirsty and sweaty again from there on (devoured 3 oranges and 2 pts squash when I got in), finishing was never in doubt. AND I DID! THIS IS THE LONGEST DURATION RUN I'VE EVER DONE, AND I'VE FINALLY BEATEN MY PREVIOUS RECORD OF 3:57:40 HELD FOR 13 YEARS! This is now Iron Man run No.21 this year and my first DOUBLE! It's also the furthest I've run this year and the furthest distance ever run on this day of the year!
8670	Wed, 15 Sep 2021	OTHER				114	71%	J	Indoor bike session, 60 mins. Think I must have strained my intercostal (chest) muscle in the night (no discomfort during run yesterday but bad when I got up this morning).
8671	Thu, 16 Sep 2021	REST					0%		Very well deserved. Intercostal muscle really tight, sharp pain leaves me momentarily breathless. Worried how this will affect the next run.
8672	Fri, 17 Sep 2021	OTHER				113	70%	J	Indoor bike session, 60 mins.
Training Log

Cell Formulas
Range	Formula
E8669	E8669	=D8669/C8669
G8666:G8672	G8666	=F8666/(220-(DATEDIF($G$7,A8666,"Y")))

Named Ranges
Name	Refers To	Cells
LastLogDate	=OFFSET('Training Log'!$A$11,'Training Log'!$B$10,0)	G8672
LastRunDate	=OFFSET('Training Log'!$A$11,'Training Log'!$B$10,0)	G8672
Log_LastDate	=INDEX('Training Log'!All_Log_Dates,ROWS('Training Log'!All_Log_Dates))	G8672

Sheet 'Indoor Bike' extract

Copy of Exercise Log for MrExcel posts.xlsx
	A	B	C	D	E	F	G	H	I	J
349	Sat, 11 Sep 2021	1:00:00	20.0	12.4	8	111	69%	148	J	Session 339. 6:10pm. Black Sabbath Live At Last (perfect speed for getting used to new level). Legs bit tired for first 5-10 mins then started to get used to it. I know the overall output is less than the last session (2½hr run yesterday) but my legs felt they were getting used to it much earlier in the session and it didn't feel as much of a grind. Maybe the familiar music made it easier?
350	Mon, 13 Sep 2021	1:00:00	21.0	13.0	8	116	72%	155	J	Session 340. 5:45pm. Hawkwind Space Ritual (great music, Gong at 45rpm with a good beat!). Was asleep nearly all afternoon after 5hrs sleep last night and all lost sleep being up on MrExcel.com until 4-5am night after night - looks like it paid off as after a couple of mins quads were v light and strong and stayed that way the whole way round, even managing 180W for the last 10 secs. V good session.
351	Wed, 15 Sep 2021	1:00:00	20.8	12.9	8	114	71%	154	J	Session 341. 7:00pm. Zep Cleveland 28.04.1977 (in celebration of first ever >4hr run yesterday). Great session, even better coming so soon after yesterday's run. Quads got v strong after first 5 mins warming up and legs became nice and light as if I hadn't even run yesterday. Inner core muscles had been bit cramped during day but session lessened it. R hand was cramping like hell though for last 20 mins. Starting to own this level already!
352	Fri, 17 Sep 2021	1:00:00	20.6	12.8	8	113	70%	152	J	Session 342. 5:15pm. Beck, Bogart & Appice 1972 (good guitar & drums, rubbish vocalist) + first 15 mins of Mahogany Rush Live. Legs cranky for at least first 15 mins, then found it quite hard work until around 45 mins when they were finally nice and light. Pleasantly surprised wattage was so high.
Indoor Bike

Cell Formulas
Range	Formula
D349:D352	D349	=IF(B349>0,C349*0.621,"")
G349:G352	G349	=F349/(220-(DATEDIF($F$1,A349,"Y")))

 

[Michael M]

At the club now but someone might be able to finish this for you, I think it's close....at least it will give you a BUMP

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "I").End(xlUp).Row
For r = lr To 2 Step -1
If InStr(Range("I" & r), "Indoor Bike Session") Then
With Sheets("Indoor Bike")
    .Columns("A:A").Find(What:=Sheets("Training Log").Range("A" & r).Value, After:=Range("A10"), LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
        .Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 10)
End With
End If
Next r
End Sub

 

[Ironman]

Is there anybody there?

 

[Michael M]

Stil haven't had chance to look further into this, but I did note that by doing this you are going to add about 450 Hyperlinks into your workbook.
Given the size of your workbook currently (34Mb), while this won't affect the size by much, it could have a dramatic performance hit, especially seeing the sheets involved have Selectionchange events, changeevents And clickevents running. I think I'd seriously reconsider this action.....but I'm open to input from others regarding my comments !!

 

[Ironman]

I've been thinking - what about a one-off macro that converts all the identified links at once and I can then add future links manually?

 

[Michael M]

Yeah got that....I have put this together and it creates the hyperlink in the cell, but it comes up with a name error.....SO STILL DOESNT WORK AS REQUIRED
I'm hoping someone can pick up the error, 'cause I simply can't spot it !!
Once that is rectified the MsgBox line can be removed for it to do the whole sheet

Sub FindValues()
Dim TL As Worksheet, IB As Worksheet, valueToSearch As String
Dim i As Long, t As Long
Set TL = Worksheets("Training Log")
Set IB = Worksheets("Indoor Bike")
lr1 = TL.Cells(Rows.Count, "A").End(xlUp).Row
lr2 = IB.Cells(Rows.Count, "A").End(xlUp).Row
For i = 12 To lr1
If InStr(Cells(i, "H"), "Indoor bike session") Then
     valueToSearch = TL.Cells(i, 1)
     For t =12 To lr2
        If IB.Cells(t, 1) = valueToSearch Then
            MsgBox "found on row" & i
           ActiveSheet.Hyperlinks.Add anchor:=Range("H" & i), Address:="", SubAddress:="" & "Indoor Bike" & "!" & Range("J" & t) & "", _
           TextToDisplay:=Cells(i, "H").Text & "Go To Indoor Bike Sheet, Column J, Row " & t & " for Details"
            Exit For
        End If
     Next t
End If
Next i
End Sub

 

[Michael M]

Ok, finally got it working, thanks also to @Alex Blakenburg for sorting out my "address" issue
@Ironman
This code will stop at every instance of the found message...unless you remove the MsgBox line
I'd suggest doing 1 or 2 to make sure the message is suitable in the cell before letting it run

Sub FindValues()
    Dim TL As Worksheet, IB As Worksheet, valueToSearch As String
    Dim i As Long, t As Long, lr1 As Long, lr2 As Long
    Set TL = Worksheets("Training Log")
    Set IB = Worksheets("Indoor Bike")
    lr1 = TL.Cells(Rows.Count, "A").End(xlUp).Row
    lr2 = IB.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 12 To lr1
    If InStr(Cells(i, "I"), "Indoor bike session") Then
         For t = 12 To lr2
            If IB.Cells(t, 1) = valueToSearch Then
                MsgBox "found on row" & i
               ActiveSheet.Hyperlinks.Add Anchor:=Range("I" & i), Address:="", SubAddress:="'" & "Indoor Bike" & "'!" & Range("J" & t).Address, _
               TextToDisplay:=Cells(i, "I").Text & "Go To Indoor Bike Sheet, Column J, Row " & t & " for Details"
                Exit For
            End If
         Next t
    End If
    Next i
End Sub

 

[Ironman]

Hi Michael and @Alex Blakenburg

Many thanks for the above code

I've created a module and ran it but nothing happened. I then tried it in a worksheet_change event and it still didn't run.

 

[Alex Blakenburg]

Hi Michael and @Alex Blakenburg

Many thanks for the above code

I've created a module and ran it but nothing happened. I then tried it in a worksheet_change event and it still didn't run.

Strange the code posted seems to be missing a line.

Please add the line below straight after the "If Instr(..." line

valueToSearch = TL.Cells(i, 1)

 

[Ironman]

Many thanks Alex, it's running, msgbox by msgbox (no cancel option) - I won't be able to view the results until I've clicked another 150 or so times but I'll post back when I've finished.