VBA to increase range of hyperlink row refs by 1 each year

[Ironman]

Hi

A4:A27 of Sheet 'Iron Man Log' contains hyperlinks to a different cell in Column B of the same sheet.

Assuming this is possible, I'd be grateful for some code for This Workbook that will trigger on Jan 1 every year and will increase all of the row references in this range by 1

e.g.

In 2022 Cell A4 link ref is B32.
On Jan 1 2023 this should change to B33.
On Jan 1 2024 this should change to B34 etc

In 2022 Cell A10 link ref is B74.
On Jan 1 2023 this should change to B75.
On Jan 1 2024 this should change to B76 etc

Many thanks!

 

[NoSparks]

Perhaps this.
Not exactly what you describe but I believe the outcome is what you're after.
It doesn't add 1, it finds where those years start, below row 30, and uses the B cell address
so it should be right any time it's run and not dependent on January first.

You had removed the ThisWorkbook Workbook_Open from the last of your files I downloaded so don't know where
to suggest calling this from in that sub.

Sub RenewHypLnks()

Dim ws As Worksheet, SearchRng As Range
Dim rng As Range, cel As Range
Dim findStr As String, fndStr As Range

Set ws = Sheets("Iron Man Log")
With ws
    
    Set rng = ws.Range("A4:A26") 'because in my copy of your workbook that's as far as the years go
    Set SearchRng = .Range("A30:A" & .Rows.Count)
    
    For Each cel In rng
        findStr = cel.Value
        ' Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
        Set fndStr = SearchRng.Find(findStr, .Range("A30"), xlValues, xlPart, xlByRows, xlNext, False, False, False)
        If Not fndStr Is Nothing Then
            cel.Hyperlinks(1).SubAddress = "'Iron Man Log'!" & fndStr.Offset(, 1).Address(0, 0)
        Else
            MsgBox "The year " & findStr & " was not found."
        End If
    Next cel
End With
        
End Sub

 

[Ironman]

Hey thanks a lot once again NS, what a great way of thinking kudos to you!

Yes, I did remove the Workbook_Open event from the last file to help you, because you had previously had problems opening the workbook, so it must have been something in that event.

Yes, I have indeed since inserted another row (A27) for 2022.

To clarify, there will always be a blank row below the current year. The format is the below:

2022	2	18	0
Total 1984-2022	223	Total > 3 Hours	41
DATE	DISTANCE	TIME	PACE	RANK/223	DETAILS
Mon, 7 May 1984	16.0	2:14:43	8:25	144	LOG ENTRY

I guess the above doesn't affect your code as it's only looking for hyperlinks?

As I'll only be running the module at the start of the year, would the below work in the Workbook Open event?

If Date = DateSerial(Year(Date), 1, 1) Then
Call RenewHypLnks
End If

Many thanks again!

 

[NoSparks]

As I'll only be running the module at the start of the year, would the below work in the Workbook Open event?

Yes, and if you were to open the workbook more than once on the first of January the links would stay the same, unlike with your original line of thought of increasing the cell ref.

The code doesn't actually look for hyperlinks, it looks for where the hyperlink should refer to, and then overwrites the existing hyperlink with what it finds.

Yes, I have indeed since inserted another row (A27) for 2022.

I guess the above doesn't affect your code as it's only looking for hyperlinks?

Yes it will effect the code, if you're inserting rows then the bottom of the range with hyperlinks will be expanding down and the top of the search range (was A30) will also need adjustment.
This should look after both

Sub RenewHypLnks()

Dim ws As Worksheet, SearchRng As Range
Dim rng As Range, cel As Range
Dim findStr As String, fndStr As Range
Dim rngBottom As Long

Set ws = Sheets("Iron Man Log")
With ws
    rngBottom = .Range("A4").End(xlDown).Row
    Set rng = .Range("A4:A" & rngBottom)
    Set SearchRng = .Range("A" & rngBottom + 4 & ":A" & .Rows.Count)
    For Each cel In rng
        findStr = cel.Value
        ' Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
        Set fndStr = SearchRng.Find(findStr, .Range("A" & rngBottom + 4), xlValues, xlPart, xlByRows, xlNext, False, False, False)
        If Not fndStr Is Nothing Then
            cel.Hyperlinks(1).SubAddress = "'Iron Man Log'!" & fndStr.Offset(, 1).Address(0, 0)
        Else
            MsgBox "The year " & findStr & " was not found."
        End If
    Next cel
End With
        
End Sub

 

[Ironman]

That's brilliant, thanks ever so much for all the thought you've given to that NS.

 

[Ironman]

Hi again - I've just realised there are also links in Col D, my apologies, I don't know how I missed those.

Would it be possible for you to modify your code to include Col D as well please?

Thanks a lot once again!

 

[NoSparks]

Would it be possible for you to modify your code to include Col D as well please?

Don't know.
I can see they refer to the first date in the year that is over 3 hours and the number displayed is how many times in the year, but I can't find where those hyperlinks are originating from. Have you been inserting them manually?

 

[Ironman]

Yes, I inserted them manually, exactly as you've observed.

 

[NoSparks]

Hmmm...
I guess that leads to a new question of how to automate the creation of those hyperlinks.
Then updating of those hyperlinks would pretty much just be re-creating them.

 

[Ironman]

Don't worry too much NS as there are only a handful of links