Question : Script that check 2 colums in 2 sheets and hyperlinks. Need a way to check exact match and hyperlink.

Hi,

Script that check 2 colums in 2 sheets and hyperlinks. Need a way to check exact match and hyperlink.
At present say i have a word as

Sharath C
It hyperlinks Sharath to Sharath C

Case should not be a matter but exact match should be linked.

Can anyone help changing the code.

REgards
sharath
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
Sub createhyperlink()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rng As Range
    Dim c As Range
    Dim rng2 As Range

    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Sheet2")
    Set rng = ws1.Range("a2:A" & ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row)

    For Each c In rng
    If c.Value <> "" Then
        x = c.Value
        Set rng2 = ws.Columns(1).Find(What:=x, after:=ws.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not rng2 Is Nothing Then ws.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:="" & ws.Name & "!" & rng2.Address(0, 0) & "", TextToDisplay:=c.Value
        End If
    Next c
End Sub

Answer : Script that check 2 colums in 2 sheets and hyperlinks. Need a way to check exact match and hyperlink.

The update below will match whole strings


hth

Dave

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
ub createhyperlink()
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rng As Range
    Dim c As Range
    Dim rng2 As Range

    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Sheet2")
    Set rng = ws1.Range("a2:A" & ws1.Cells(Cells.Rows.Count, "A").End(xlUp).Row)

    For Each c In rng
    If c.Value <> "" Then
        x = c.Value
        Set rng2 = ws.Columns(1).Find(What:=x, after:=ws.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not rng2 Is Nothing Then ws.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:="" & ws.Name & "!" & rng2.Address(0, 0) & "", TextToDisplay:=c.Value
        End If
    Next c
End Sub
Random Solutions  
 
programming4us programming4us