VBA Error Handling - run time error 91

JanetW

New Member
Joined
May 12, 2016
Messages
21
Hi

I have pasted an extract from some code I am writing below. I have included on error goto XXX to skip this block if the criteria cannot find the data but it is still failing. I appreciate that it may not find the text being searched for - hence the reason for the goto - but it keeps sticking on the italic area. I assume this is because it can't activate the cell as it can't find the search criteria but I thought the on error goto would bypass this???


Can anybody help please????

H15:

ActiveSheet.Range("B:B").Select
On Error GoTo H16

Selection.Find(What:="Inputs declared from Cash report", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate


ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Cash Report'!G5", TextToDisplay:="b/f from Cash Report"
Selection.Font.Italic = True
GoTo H16

H16:

ActiveSheet.Range("B:B").Select
On Error GoTo H17
Selection.Find(What:="Business related RC/AQ reclaim", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Report'!I5", TextToDisplay:="b/f from Purchase Report"
Selection.Font.Italic = True
GoTo H17
 
Try this.
Rich (BB code):
    Set rngfnd = ActiveSheet.Range("B:B").Find(What:="Inputs declared from Cash report", After:=ActiveCell, LookIn:=xlValues, _
                                               LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                               MatchCase:=True, SearchFormat:=False)
    If Not rngfnd Is Nothing Then
        With rngfnd.Offset(0, 3)
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Cash Report'!G5", TextToDisplay:="b/f from Cash Report"
            .Font.Italic = True
        End With
    End If

    Set rngfnd = ActiveSheet.Range("B:B").Find(What:="Business related RC/AQ reclaim", After:=ActiveCell, LookIn:=xlValues, _
                                               LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                               MatchCase:=True, SearchFormat:=False)
    If Not rngfnd Is Nothing Then
        With rngfnd.Offset(0, 3)
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Cash Report'!G5", TextToDisplay:="b/f from Cash Report"
            .Font.Italic = True
        End With
    End If


Hi Norie

Theses are the lines where the run time 13 error appears

Thanks for your help!
 
Upvote 0

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Hi,
Rather than keep repeating the find code see if following suggestion will work for you:

Rich (BB code):
Sub SearchColumnB()
    Dim Search As Variant, SubAddressLink As Variant
    Dim ReportName As String
    Dim i As Integer
    Dim FoundCell As Range
    
    Search = Array("Inputs declared from Cash report", "Business related RC/AQ reclaim")
    SubAddressLink = Array("'Cash Report'!G5", "'Purchase Report'!I5")
    
    i = LBound(Search)
    Do
        ReportName = Mid(SubAddressLink(i), 2, InStr(1, SubAddressLink(i), " ") - 1)
        
        Set FoundCell = ActiveSheet.Columns(2).Find(What:=Search(i), After:=Cells(1, 2), LookIn:=xlValues, _
                                                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                    MatchCase:=False, SearchFormat:=False)
        
        If Not FoundCell Is Nothing Then
            With FoundCell.Offset(0, 3)
                .Hyperlinks.Add Anchor:=FoundCell.Offset(0, 3), _
                    Address:="", SubAddress:=SubAddressLink(i), _
                    ScreenTip:="Goto " & ReportName & " Report", _
                    TextToDisplay:="b/f from " & ReportName & " Report"
                .Font.Italic = True
            End With
        End If
        i = i + 1
        Set FoundCell = Nothing
    Loop Until i > UBound(Search)
    
End Sub

You will need to add to the values shown in RED as required.
Solution is untested but hopefully will give you something that you can work with.

Dave


Hi Dave

Thanks for response - I have several sheets to do this on with different search ranges so I presume I would have to repeat this several times changing sheet names, search cells etc?

Janet
 
Upvote 0
Hi Dave

Thanks for response - I have several sheets to do this on with different search ranges so I presume I would have to repeat this several times changing sheet names, search cells etc?

Janet


Hi Janet,
suggestion was alternative approach you could try to reduce repeating code & was based on code your shared on forum. Yes you would need to expand it to accommodate a bigger requirement but without fully knowing what the requirement is a little difficult to assist. If you could place sample copy of your workbook in a dropbox this would help.

Dave
 
Upvote 0
This works for me without error.
Code:
Dim rngFnd As Range

    Set rngFnd = ActiveSheet.Range("B:B").Find(What:="Inputs declared from Cash report", After:=ActiveCell, LookIn:=xlValues, _
                                               LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                               MatchCase:=True, SearchFormat:=False)

    If Not rngFnd Is Nothing Then
        With rngFnd.Offset(0, 3)
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Cash Report'!G5", TextToDisplay:="b/f from Cash Report"
            .Font.Italic = True
        End With
    End If

    Set rngFnd = ActiveSheet.Range("B:B").Find(What:="Business related RC/AQ reclaim", After:=ActiveCell, LookIn:=xlValues, _
                                               LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                               MatchCase:=True, SearchFormat:=False)

    If Not rngFnd Is Nothing Then
        With rngFnd.Offset(0, 3)
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Report'!I5", TextToDisplay:="b/f from Purchase Report"
            .Font.Italic = True
        End With
    End If
 
Upvote 0
Hi Janet,
suggestion was alternative approach you could try to reduce repeating code & was based on code your shared on forum. Yes you would need to expand it to accommodate a bigger requirement but without fully knowing what the requirement is a little difficult to assist. If you could place sample copy of your workbook in a dropbox this would help.

Dave


Hi Dave

Original post was just a sample to see if anyone could answer what I was doing wrong with on error coding. I basically have several sheets, each with different searches in different columns with hyperlinks being populated in varying offset cells if date is found - descriptions for hyperlinks changes throughout too (some are b/f, some are c/f - some are just comments that don't mention the sheet name!)

I don't know how to add workbook in a dropbox (only posted on here once before!) but my full original attempt is below:!!


Workbooks(NewWB).Sheets("Cash Report").Activate



ActiveSheet.Range("E:E").Select
On Error GoTo H2
Selection.Find(What:="Inputs declared from Cash report", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Totals'!A1", TextToDisplay:="c/f to Purchase Totals"
Selection.Font.Italic = True
GoTo H2

H2:

ActiveSheet.Range("E:E").Select
On Error GoTo H3
Selection.Find(What:="Output VAT", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Income Totals'!A1", TextToDisplay:="c/f to Income Totals"
Selection.Font.Italic = True
GoTo H3

H3:
Workbooks(NewWB).Sheets("Sales Report").Activate



ActiveSheet.Range("F:F").Select
On Error GoTo H4
Selection.Find(What:="Credit Memo", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Income Totals'!A1", TextToDisplay:="c/f to Income Totals"
Selection.Font.Italic = True
GoTo H4

H4:

ActiveSheet.Range("F:F").Select
On Error GoTo H5
Selection.Find(What:="Sales Invoice", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Income Totals'!A1", TextToDisplay:="c/f to Income Totals"
Selection.Font.Italic = True
GoTo H5
H5:

ActiveSheet.Range("F:F").Select
On Error GoTo H6
Selection.Find(What:="Debit Memo", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Income Totals'!A1", TextToDisplay:="c/f to Income Totals"
Selection.Font.Italic = True
GoTo H6

H6:
Workbooks(NewWB).Sheets("Income Totals").Activate



ActiveSheet.Range("A:A").Select
On Error GoTo H7
Selection.Find(What:="Total Outputs declared from Cash Report", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Cash Report'!G5", TextToDisplay:="b/f from Cash Report"
Selection.Font.Italic = True
GoTo H7

H7:

ActiveSheet.Range("A:A").Select
On Error GoTo H8
Selection.Find(What:="Total Output VAT Declared From Sales Report", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Sales Report'!H8", TextToDisplay:="b/f from Sales Report"
Selection.Font.Italic = True
GoTo H8

H8:


ActiveSheet.Range("A:A").Select
On Error GoTo H9
Selection.Find(What:="Total Back End Adjustments", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Income Totals'!D30", TextToDisplay:="b/f from below. Items added from requests, prior months or Journal posting"
Selection.Font.Italic = True
GoTo H9
H9:

ActiveSheet.Range("A:A").Select
On Error GoTo H10
Selection.Find(What:="Total RC/AQ payable c/f box 1 & 2", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Reports'!H5", TextToDisplay:="b/f from Purchase Report"
Selection.Font.Italic = True
GoTo H10

H10:


Workbooks(NewWB).Sheets("Purchase Report").Activate



ActiveSheet.Range("F:F").Select
On Error GoTo H11
Selection.Find(What:="Total RC/AQ payable c/f box 1 & 2", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 4).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Totals'!D25", TextToDisplay:="c/f to Income Totals to Declare as Output Tax"
Selection.Font.Italic = True
GoTo H11

H11:

ActiveSheet.Range("F:F").Select
On Error GoTo H12
Selection.Find(What:="Total COS input tax (excl RC/AQ)", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 4).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Totals'!D5", TextToDisplay:="c/f to Purchase Totals"
Selection.Font.Italic = True
GoTo H12

H12:

ActiveSheet.Range("F:F").Select
On Error GoTo H13
Selection.Find(What:="Total business (incl import tax) input tax", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 4).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Totals'!D6", TextToDisplay:="c/f to Purchase Totals"
Selection.Font.Italic = True
GoTo H13


H13:
Workbooks(NewWB).Sheets("Purchase Totals").Activate
ActiveSheet.Range("B:B").Select
On Error GoTo H14
Selection.Find(What:="Total COS input tax (excl RC/AQ)", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Report'!I6", TextToDisplay:="b/f from Purchase Report"
Selection.Font.Italic = True
GoTo H14
H14:

ActiveSheet.Range("B:B").Select
On Error GoTo H15
Selection.Find(What:="Total business (incl import tax) input tax", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Report'!I7", TextToDisplay:="b/f from Purchase Report"
Selection.Font.Italic = True
GoTo H15
H15:

ActiveSheet.Range("B:B").Select
On Error GoTo H16
Selection.Find(What:="Inputs declared from Cash report", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Cash Report'!G5", TextToDisplay:="b/f from Cash Report"
Selection.Font.Italic = True
GoTo H16


H16:

ActiveSheet.Range("B:B").Select
On Error GoTo H17
Selection.Find(What:="Business related RC/AQ reclaim", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Report'!I5", TextToDisplay:="b/f from Purchase Report"
Selection.Font.Italic = True
GoTo H17
H17:

ActiveSheet.Range("B:B").Select
On Error GoTo H18
Selection.Find(What:="Total Back end adjustments", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 3).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Totals'!D14", TextToDisplay:="b/f from below. Items added from requests, prior months or Journal posting"
Selection.Font.Italic = True
 
Upvote 0
Hi,
you could try making my suggestion a common code and from your various worksheets, pass the required values to it.

Give this a try & see if it works for you.

Place following in a STANDARD module:

Rich (BB code):
Sub SearchColumn(ByVal sh As Object, ByVal Search As Variant, ByVal SearchColumn As Variant, ByVal CellOffset As Integer, ByVal SubAddressLink As Variant, ByVal TextDisplay As String)
    Dim ReportName As String
    Dim i As Integer
    Dim FoundCell As Range
    
    i = LBound(Search)
    Do
        ReportName = Mid(SubAddressLink(i), 2, InStr(2, SubAddressLink(i), "'") - 2)
        
        Set FoundCell = sh.Columns(SearchColumn).Find(What:=Search(i), After:=sh.Cells(1, 2), LookIn:=xlValues, _
                                                            LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                                            SearchDirection:=xlNext, MatchCase:=False, _
                                                            SearchFormat:=False)
        
        If Not FoundCell Is Nothing Then
            With FoundCell.Offset(0, CellOffset)
                .Hyperlinks.Add Anchor:=FoundCell.Offset(0, 3), _
                    Address:="", SubAddress:=SubAddressLink(i), _
                    ScreenTip:="Goto " & ReportName, _
                    TextToDisplay:=TextDisplay & ReportName
                .Font.Italic = True
            End With
        End If
        i = i + 1
        Set FoundCell = Nothing
    Loop Until i > UBound(Search)
    
End Sub


I assume that you are running your code from a commandbutton in worksheet?

Place following in appropriate worksheets code page:

Rich (BB code):
Private Sub CommandButton1_Click()
    Dim Search As Variant, SubAddressLink As Variant
    
    Search = Array("Inputs declared from Cash report", "Business related RC/AQ reclaim")
    SubAddressLink = Array("'Cash Report'!G5", "'Purchase Report'!I5")
    
    SearchColumn sh:=Me, Search:=Search, SearchColumn:=2, _
                 CellOffset:=3, SubAddressLink:=SubAddressLink, _
                 TextDisplay:="b/f from "
End Sub

You need to build the arrays shown in RED as required.
For clarity, I have included the parameter names to the SearchColumn procedure call to make it easier for you to understand - as you can see, you just set the required values for SearchColumn, CellOffset & TextDisplay & hopefully, it will do what you want.

If you are not able to adapt idea to meet your requirement then perhaps working with one of the other suggestions may help.

Dave
 
Last edited:
Upvote 0
Hi,
you could try making my suggestion a common code and from your various worksheets, pass the required values to it.

Give this a try & see if it works for you.

Place following in a STANDARD module:

Rich (BB code):
Sub SearchColumn(ByVal sh As Object, ByVal Search As Variant, ByVal SearchColumn As Variant, ByVal CellOffset As Integer, ByVal SubAddressLink As Variant, ByVal TextDisplay As String)
    Dim ReportName As String
    Dim i As Integer
    Dim FoundCell As Range
    
    i = LBound(Search)
    Do
        ReportName = Mid(SubAddressLink(i), 2, InStr(2, SubAddressLink(i), "'") - 2)
        
        Set FoundCell = sh.Columns(SearchColumn).Find(What:=Search(i), After:=sh.Cells(1, 2), LookIn:=xlValues, _
                                                            LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                                            SearchDirection:=xlNext, MatchCase:=False, _
                                                            SearchFormat:=False)
        
        If Not FoundCell Is Nothing Then
            With FoundCell.Offset(0, CellOffset)
                .Hyperlinks.Add Anchor:=FoundCell.Offset(0, 3), _
                    Address:="", SubAddress:=SubAddressLink(i), _
                    ScreenTip:="Goto " & ReportName, _
                    TextToDisplay:=TextDisplay & ReportName
                .Font.Italic = True
            End With
        End If
        i = i + 1
        Set FoundCell = Nothing
    Loop Until i > UBound(Search)
    
End Sub


I assume that you are running your code from a commandbutton in worksheet?

Place following in appropriate worksheets code page:

Rich (BB code):
Private Sub CommandButton1_Click()
    Dim Search As Variant, SubAddressLink As Variant
    
    Search = Array("Inputs declared from Cash report", "Business related RC/AQ reclaim")
    SubAddressLink = Array("'Cash Report'!G5", "'Purchase Report'!I5")
    
    SearchColumn sh:=Me, Search:=Search, SearchColumn:=2, _
                 CellOffset:=3, SubAddressLink:=SubAddressLink, _
                 TextDisplay:="b/f from "
End Sub

You need to build the arrays shown in RED as required.
For clarity, I have included the parameter names to the SearchColumn procedure call to make it easier for you to understand - as you can see, you just set the required values for SearchColumn, CellOffset & TextDisplay & hopefully, it will do what you want.

If you are not able to adapt idea to meet your requirement then perhaps working with one of the other suggestions may help.

Dave


Hi Dave

I managed to adapt your first code so I have one for each sheet(5) and after an initial hiccup with merged cells it is now working just as I wanted it to...:)

Many thanks for your help :):):)

Janet
 
Upvote 0
This works for me without error.
Code:
Dim rngFnd As Range

    Set rngFnd = ActiveSheet.Range("B:B").Find(What:="Inputs declared from Cash report", After:=ActiveCell, LookIn:=xlValues, _
                                               LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                               MatchCase:=True, SearchFormat:=False)

    If Not rngFnd Is Nothing Then
        With rngFnd.Offset(0, 3)
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Cash Report'!G5", TextToDisplay:="b/f from Cash Report"
            .Font.Italic = True
        End With
    End If

    Set rngFnd = ActiveSheet.Range("B:B").Find(What:="Business related RC/AQ reclaim", After:=ActiveCell, LookIn:=xlValues, _
                                               LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                               MatchCase:=True, SearchFormat:=False)

    If Not rngFnd Is Nothing Then
        With rngFnd.Offset(0, 3)
            .Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Purchase Report'!I5", TextToDisplay:="b/f from Purchase Report"
            .Font.Italic = True
        End With
    End If

Hi Norie

Many thanks for your help but I still couldn't get it to work at my end (!?!)

I have managed to adapt dmt32's response to fit my requirements but thanks for taking the time to reply - much appreciated

Janet
 
Upvote 0
Hi Dave

I managed to adapt your first code so I have one for each sheet(5) and after an initial hiccup with merged cells it is now working just as I wanted it to...:)

Many thanks for your help :):):)

Janet

Hi Janet,
most welcome - glad solution helped.

Many thanks for feedback

Dave
 
Upvote 0
Janet,
I neglected to make one minor change to the common code & you may get an error.

Use this version:

Code:
Sub SearchColumn(ByVal sh As Object, ByVal Search As Variant, ByVal SearchColumn As Variant, ByVal CellOffset As Integer, ByVal SubAddressLink As Variant, ByVal TextDisplay As String)
    Dim ReportName As String
    Dim i As Integer
    Dim FoundCell As Range
    
    i = LBound(Search)
    Do
        ReportName = Mid(SubAddressLink(i), 2, InStr(2, SubAddressLink(i), "'") - 2)
        
        Set FoundCell = sh.Columns(SearchColumn).Find(What:=Search(i), After:=sh.Cells(1, SearchColumn), LookIn:=xlValues, _
                                                            LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                                            SearchDirection:=xlNext, MatchCase:=False, _
                                                            SearchFormat:=False)
        
        If Not FoundCell Is Nothing Then
            With FoundCell.Offset(0, CellOffset)
                .Hyperlinks.Add Anchor:=FoundCell.Offset(0, 3), _
                    Address:="", SubAddress:=SubAddressLink(i), _
                    ScreenTip:="Goto " & ReportName, _
                    TextToDisplay:=TextDisplay & ReportName
                .Font.Italic = True
            End With
        End If
        i = i + 1
        Set FoundCell = Nothing
    Loop Until i > UBound(Search)
    
End Sub

Dave
 
Upvote 0

Forum statistics

Threads
1,215,514
Messages
6,125,271
Members
449,219
Latest member
daynle

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