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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
1,069
Office Version
  1. 365
Platform
  1. Windows
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
ABCDEFGHI
8666Sat, 11 Sep 2021OTHER11169%JIndoor bike session, 60 mins.
8667Sun, 12 Sep 2021REST0%Well earned.
8668Mon, 13 Sep 2021OTHER11672%JIndoor bike session, 60 mins.
8669Tue, 14 Sep 2021Hallas 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 home17.14:13:1914:4911672%JDay 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!
8670Wed, 15 Sep 2021OTHER11471%JIndoor 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).
8671Thu, 16 Sep 2021REST0%Very well deserved. Intercostal muscle really tight, sharp pain leaves me momentarily breathless. Worried how this will affect the next run.
8672Fri, 17 Sep 2021OTHER11370%JIndoor bike session, 60 mins.
Training Log
Cell Formulas
RangeFormula
E8669E8669=D8669/C8669
G8666:G8672G8666=F8666/(220-(DATEDIF($G$7,A8666,"Y")))
Named Ranges
NameRefers ToCells
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
ABCDEFGHIJ
349Sat, 11 Sep 20211:00:0020.012.4811169%148JSession 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?
350Mon, 13 Sep 20211:00:0021.013.0811672%155JSession 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.
351Wed, 15 Sep 20211:00:0020.812.9811471%154JSession 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!
352Fri, 17 Sep 20211:00:0020.612.8811370%152JSession 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
RangeFormula
D349:D352D349=IF(B349>0,C349*0.621,"")
G349:G352G349=F349/(220-(DATEDIF($F$1,A349,"Y")))
 
Last edited:

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
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
VBA Code:
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
 
Upvote 0
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 !!
 
Upvote 0
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?
 
Upvote 0
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
VBA Code:
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
 
Upvote 0
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
VBA Code:
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
 
Upvote 0
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.
 
Upvote 0
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
VBA Code:
valueToSearch = TL.Cells(i, 1)
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,222,316
Messages
6,165,304
Members
451,950
Latest member
WH2000

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top