Hyperlinks VBA

[mlo356]

Hi All,

I am struggling with getting hyperlinks to work in VBA using vlookup. Any help would be appreciated

I have 2 sheets.

Sheet 1 has a salesman # in cell A1. To keep it simple, the salesman # is 101. no hyperlink exist yet.

Sheet 2 has a list of salesman #s in column A and salesman #101 is in this list. Columns B-E has info related to the salesman

I would like to lookup the salesman # in sheet1.A1 (which is 101) on sheet2.A:A.

If it finds the salesman #, Convert text in sheet1.A1 into a link. the link takes me to the matching row on sheet2.

If not found, do not convert to link

I was going to upload code but I failed miserably at it and don't think would be useful.

Thanks in advance!

 

[mrshl9898]

This creates links for all

Sub findsalesman()

Dim rownum As Long
Dim rownum1 As Long
Dim salesman As String
Dim salesmanfound As String

Sheets("Sheet2").select


rownum1 = 1
rownum = 1


Do Until Sheets("Sheet1").Cells(rownum1, 1).Value = ""


salesman = Sheets("Sheet1").Cells(rownum1, 1).Value




    Do Until Sheets("Sheet2").Cells(rownum, 1).Value = ""


        If Sheets("Sheet2").Cells(rownum, 1).Value = salesman Then


        salesmanfound = Sheets("Sheet2").Cells(rownum, 1).Address
        
        GoTo nextsalesman


        End If


        rownum = rownum + 1


    Loop


nextsalesman:


Sheets("Sheet1").Select
Sheets("Sheet1").Cells(rownum1, 1).Select
Sheets("Sheet1").Cells(rownum1, 1).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Sheet2!" & salesmanfound


rownum = 1


rownum1 = rownum1 + 1


Loop


End Sub

 

[mlo356]

This creates links for all

Sub findsalesman()

Dim rownum As Long
Dim rownum1 As Long
Dim salesman As String
Dim salesmanfound As String

Sheets("Sheet2").select


rownum1 = 1
rownum = 1


Do Until Sheets("Sheet1").Cells(rownum1, 1).Value = ""


salesman = Sheets("Sheet1").Cells(rownum1, 1).Value




    Do Until Sheets("Sheet2").Cells(rownum, 1).Value = ""


        If Sheets("Sheet2").Cells(rownum, 1).Value = salesman Then


        salesmanfound = Sheets("Sheet2").Cells(rownum, 1).Address
        
        GoTo nextsalesman


        End If


        rownum = rownum + 1


    Loop


nextsalesman:


Sheets("Sheet1").Select
Sheets("Sheet1").Cells(rownum1, 1).Select
Sheets("Sheet1").Cells(rownum1, 1).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Sheet2!" & salesmanfound


rownum = 1


rownum1 = rownum1 + 1


Loop


End Sub

Thank You so much mrshl9898!! This worked great. Didn't think to use a loop.