Remove all text except URLs

[jjokol]

How can I remove all the text from a spreadsheet except URLs? Another way to look at it would be removing all text except anything that begins www.

 

[jjokol]

No one help with this?

 

[Richard Schollar]

Would it be acceptable to extract all the URLs from the sheet and insert in a new one?

 

[jjokol]

Would it be acceptable to extract all the URLs from the sheet and insert in a new one?

That would be fine, Richard

 

[jjokol]

Anyone else? Don't seem to be getting any help with this.

 

[Richard Schollar]

Try this:

Sub test2()
Dim oMatch, oMatches
Dim ws As Worksheet
Dim rngAll As Range, rngFound As Range
Dim strFirstAddress As String

Set rngFound = ActiveSheet.UsedRange.Find(What:="www.", LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)

If Not rngFound Is Nothing Then
    'check if any cells contain "www.":
    Set rngAll = rngFound
    strFirstAddress = rngFound.Address
    'loop thru all instances of "www." in sheet to return all relevant cells:
    Do
        Set rngFound = ActiveSheet.Cells.FindNext(rngFound)
        If rngFound.Address <> strFirstAddress Then _
            Set rngAll = Application.Union(rngAll, rngFound)
    Loop While strFirstAddress <> rngFound.Address
Else
    MsgBox "No URLs found!"
    Exit Sub
End If

'now extract all URLs and append to new sheet:

Set ws = Worksheets.Add
ws.Range("A1") = "URL"

With CreateObject("vbscript.regexp")
    .Global = True
    .ignorecase = True
    .Pattern = "www\.[^ ]+"
    For Each rngFound In rngAll
        If .test(rngFound.Value) Then
            Set oMatches = .Execute(rngFound.Value)
            For Each oMatch In oMatches
                ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1).Value = oMatch
            Next oMatch
            Set oMatches = Nothing
        End If
    Next rngFound
End With

End Sub

 

[jjokol]

Many thanks Richard. Works perfectly. Is it possible to make one final tweak... to remove the ending / on all domains: eg www.domain.co.uk/ should be www.domain.co.uk

 

[Richard Schollar]

Sure - just change the Pattern line to:

.Pattern = "www\.[^ ]+[^ /]"

 

[jjokol]

Very grateful, Richard. THanks.