CellInR_AddRemoveHyperlinks.bas

Sub AddRemoveHyperLinks()
Dim prv As String
Dim Cell As Range
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'written by Angelina Teneva, September 2016
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For Each Cell In ActiveSheet.Range("B2:B" & ActiveSheet.UsedRange.Rows.Count)

    If Cell.Hyperlinks.Count = 0 Then
    
        prv = Cell.Value
        
        If InStr(1, Cell, "@", vbTextCompare) <> 0 Then
            Cell.Hyperlinks.Add Anchor:=Cell, Address:="mailto:" & prv      'adds hyperlink to an e-mail
        Else
            Cell.Hyperlinks.Add Anchor:=Cell, Address:=prv                  'adds hyperlink to a website
        End If
    Else
    
        Cell.Hyperlinks.Delete                                              'delete a hyperlink from a cell
    
    End If
                                         
Next Cell
End Sub