asked on

Excel: Add Asterisk to the End

Hi Experts,

I have a column that contains domain names:

Example:

abc.com
xyz.com
321.net
456.ru
213.mine.com
mydomain.123.hellokitty.net
and so on...

I'd like to remove everything past the last dot "." and replace it with an asterisk so that the end result looks like this:

http://abc*
https://abc*
http://xyz*
https://xyz*
http://321*
https://321*
http://213.mine*
https://213.mine*
http://mydomain.123.hellokitty*
https://mydomain.123.hellokitty*

1.) drops everything after the lost dot (.)
2.) replaces the last dot and everything after that last dot with an asteriks (*)
3.) creates two entries on that cells value e.g. http://mydomain.123.hellokitty* and https://mydomain123.hellokitty* (This way it captures both HTTP:// protocols)

Any help with this is GREATLY APPRECIATED!

byundt

Sub StarDot()
Dim vAddresses As Variant, vResults As Variant
Dim i As Long, k As Long, n As Long
Dim rg As Range
Dim s As String
With ActiveSheet
    Set rg = .Range("A2")    'First cell with data
    Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp))
    vAddresses = rg.Value
    n = rg.Rows.Count
    ReDim vResults(1 To 2 * n)
    k = -1
    On Error Resume Next
    For i = 1 To n
        s = vAddresses(i, 1)
        If s <> "" Then
            If InStr(1, s, ".") > 0 Then
                k = k + 2
                s = Left(s, InStrRev(s, ".") - 1)
                vResults(k) = "http://" & s & "*"
                vResults(k + 1) = "https://" & s & "*"
            End If
        End If
    Next
    On Error GoTo 0
    k = k + 1
    ReDim Preserve vResults(1 To k)
    rg.Cells(1).Resize(k).Value = Application.Transpose(vResults)
End With
End Sub

Open in new window

itsmevic

ASKER

Hi byundt! I haven't seen that name in a while...lol! Hope you are doing well during all this craziness! So, I ran the macro, but it seems to be choking on line 27 "ReDim Preserve vResults(1 To k) for some reason.

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

SOLUTION

Brian B

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial