Tests Copying pasting Cliipboard issues

[DocAElstein]

White Spam URL WhiteSpamUrl WhiteSpamUrl()

Sub WhiteSpamUrl()   '   White Spam URL  WhiteSpamUrl WhiteSpamUrl()  https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222     https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18376&viewfull=1#post18376
Dim ClipTxt As String: Let ClipTxt = "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]" & vbCr & vbLf
Dim SelText As String
 Let SelText = Selection.Text
Dim RwTxt() As String
 Let RwTxt() = Split(SelText, vbCr, -1, vbBinaryCompare)
Dim RwCnt As Long
    For RwCnt = LBound(RwTxt()) To UBound(RwTxt())
    Dim ClmTxt() As String
     Let ClmTxt() = Split(RwTxt(RwCnt), " ", -1, vbBinaryCompare)
    Dim ClmCnt As Long
        For ClmCnt = LBound(ClmTxt()) To UBound(ClmTxt())
            If InStr(1, Trim(ClmTxt(ClmCnt)), "//www.", vbBinaryCompare) > 0 Then
            Dim URL As String, URL2 As String
             Let URL = Trim(ClmTxt(ClmCnt))
             Let URL2 = Replace(URL, "http", "ht[color=white]tp[/color]", 1, 1, vbBinaryCompare)
             Let URL2 = Replace(URL2, "//www.", "/[color=white]/ww[/color]w.", 1, 1, vbBinaryCompare)
             Let ClipTxt = ClipTxt & "[url=" & URL & "] [color=white] " & URL2 & " [/color] [/url]" & vbCr & vbLf
            Else
            ' no url
            End If
        
        Next ClmCnt
    Next RwCnt
 Let ClipTxt = ClipTxt & "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]"

'   Put the string in the clipboard
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '   web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
     .SetText ClipTxt
     .PutInClipboard
    End With
End Sub