Sub URLlinker() ' Paul Beverley - Version 14.04.22 ' Finds all URLs in the text and links them charsInURLs = "[%./:a-zA-Z0-9_\-\?^38=+]" Set rng = ActiveDocument.Range myFind = "<[wthps]{3,5}>" & charsInURLs & "{1,}" With rng.Find .Text = myFind .Replacement.Text = "" .Wrap = wdFindStop .Forward = True .MatchWildcards = True .Execute End With Do While rng.Find.Found = True rng.Select Selection.Collapse wdCollapseStart stNow = Selection.Start Selection.MoveLeft , 1 stBefore = Selection.Start If stNow = stBefore + 1 Then myAddress = rng.Text rng.Text = Replace(rng.Text, "https://", "") rng.Text = Replace(rng.Text, "http://", "") rng.Select Set myLink = ActiveDocument.Hyperlinks.Add(Anchor:=rng, _ Address:=myAddress, TextToDisplay:=rng.Text) rng.Start = myLink.Range.End rng.End = ActiveDocument.Content.End Else rng.Start = rng.End End If rng.Find.Execute DoEvents Loop Beep End Sub