How to add tab link into VBA results

Rowan

Changes to the code provided for your previous question (Date Range Search Across multiple tabs?) are shown in bold below.

Basically I've declared 2 new variables- LinkAdd to capture the cell where a matching date is found and LinkText to get what's in J1 of that sheet (or an Excel style sheet!cell ref). They get added to column J of the results in Master but I insert a cell (so if there was anything in column J of a data sheet, it isn't overwritten).

Now when you search, hyperlinks get added in column J of Master, under "Hyperlink/ref" and clicking them will take to the cell on the tab where that row was found.

Sub Button1_Click()

' ### TeachExcel

Dim ws As Worksheet, LastI As Long, n As Long
Dim LastRow As Long, LinkAdd As String, LinkText As String

' clear master sheet except first 7 rows
Sheet1.UsedRange.Offset(6, 0).Delete

' Determine last used row in sheet 1
LastRow = Sheet1.Range("I" & Rows.Count).End(xlUp).Row + 1
If LastRow < 7 Then LastRow = 7
' get user dates
FirstDate = Sheet1.Range("B2").Value
Lastdate = Sheet1.Range("B3").Value

'Just tell user if dates need adding
If FirstDate = "" Or Lastdate = "" Then
    MsgBox "Please add valid dates to both cells B2 and B3"
    Exit Sub
End If

' Loop through sheets
For Each ws In ThisWorkbook.Worksheets
    ' unless it's the master sheet..
    If ws.Name <> Sheet1.Name Then
        'Find last used row in column I of that sheet...
        LastI = ws.Range("I" & Rows.Count).End(xlUp).Row
        ' and loop through column I starting at row 2:
        For n = 2 To LastI
            With ws.Cells(n, "I")
                If IsDate(.Value) And .Value >= FirstDate And .Value <= Lastdate Then
                    ' if date's in range, copy /paste to master sheet
                    .EntireRow.Copy Sheet1.Rows(LastRow)
                    ' create hyperlink address
                    LinkAdd = Chr(32) & ws.Name & "!" & .Address(0, 0) & Chr(32)
                    ' and text (=J1 if there's anything there)
                    If ws.Cells(1, "J") <> "" Then
                        LinkText = ws.Cells(1, "J").Value
                        Else
                        LinkText = LinkAdd
                    End If
                    ' move data right
                    Sheet1.Cells(LastRow, "J").Insert (1)
                    ' add hyperlink
                    Sheet1.Cells(LastRow, "J").Hyperlinks.Add _
                        Anchor:=Sheet1.Cells(LastRow, "J"), Address:="", _
                        SubAddress:=LinkAdd, TextToDisplay:=LinkText
                    'Increment row counter for next match
                    LastRow = LastRow + 1
                End If
            End With
        Next n
    End If

Next ws

' autofit column J
Sheet1.Columns("J").AutoFit

' State (in A5) what the sheet now reports and tell user
Sheet1.Range("A5").Value = "Retrieved data matching above dates: from " & FirstDate & " to " & Lastdate
MsgBox "Done! Extracted " & LastRow - 7 & " matching rows"

End Sub

Hope that fixes things for you.

 rowan853, John_Ru

John, you beat me to a solution (not surprising though  ;-)  ) and a nice one at that.

I too came up with a solution, albeit a bit different appraoch than yours (file attached)

I first made a copy of the workbook (if I mess things up I still have an original to make another copy from). This copy is where all changes were made.

I added variables as needed to use when creating HyperLinks.

I added HyperLink code – this places the HyperLink in column "J" of the "Master" sheet. The HyperLink goes to the sheet indicated and selects the date cell on that sheet in the row of the copied data.

I added a "button" (Rounded Rectangle shape) to each sheet which has a macro to go back to the "Master" sheet (also added a module with the code that will copy the button to all sheets – done – with the code assigned to the button)

I also tweaked the final message for appearance sake.

And just as rowan853 has done, there are several comments to explain what each part does.

Cheers