macro to detect domain names (in url's) ?

Hello friends,
I have an excel file with a single column, this column has 32 rows, each row has a url in it
If you look at column A you will see that sometimes the same domain name appear more than a single time (for example: domain1.com/kjh54asfdasd.html, domain1.com/asd.html, and so on...) while some other times the domain name appear only once (for example: domain3.com/kjhgfjasfdasd.html).


My question:

Is there a way to make a macro that will do the following 2 things:

1. Detect all domain names on column A from within the url's (for example: if the url is example.net/aaaaa.asp - then the macro detect example.net as the domain of the url), the detection should support the following domain type: .com, .net, .info, .org, .edu

2. Extract the first 3 instances of each domain name on column A (together with the entire url) and copy them to column B
If some domains has less than 3 instances - the macro will copy them as well


Please see file attached so you see what I mean.

your sample list does not match your description.

The sample file (as could be understood by its name) is just a sample, but the idea is the same.
However, I just edited the description to fit the sample file.

My simple question remains the same:
Is it possible to do the following 2 things with a single macro?

1. Detect all domain names on column A from within the url's (for example: if the url is example.net/aaaaa.asp - then the macro detect example.net as the domain of the url), the detection should support the following domain type: .com, .net, .info, .org, .edu

2. Extract the first 3 instances of each domain name on column A (together with the entire url) and copy them to column B
If some domains has less than 3 instances - the macro will copy them as well


Again, see the sample file attached on my first post...


Your help is highly appreciated!

Originally Posted by protonLeah

your sample list does not match your description.

Cross Posted
http://www.mrexcel.com/forum/excel-q...ames-urls.html

No, not OK...read the Forum Rules on the proper etiquette. You MAY do so if you follow the proper etiquette. The other Forum has the same rule.

As requested:

Public Sub FindTopDomains()

'#
'# declare private variables
'#
     Dim pvt_lng_RowNumber As Long
     Dim pvt_int_FindCharacter As Integer
     Dim pvt_lng_TargetRow As Long
     Dim pvt_dct_Domain As Object
     Dim pvt_str_DomainName As String
     Dim pvt_str_Extension As String
     
'#
'# initialise
'#
     Set pvt_dct_Domain = CreateObject("Scripting.Dictionary")
     pvt_lng_TargetRow = 1
     
'#
'# execute a loop on all filled rows on the worksheet - assuming that all
'# data is provided on Sheet1 - change if necessary
'#
     With ThisWorkbook.Worksheets("Sheet1")
          For pvt_lng_RowNumber = 2 To .Range("A2").CurrentRegion.Rows.Count
          
          '#
          '# isolate the domain name before the first occurence of the '/' character
          '#
               pvt_int_FindCharacter = InStr(1, .Cells(pvt_lng_RowNumber, "A").Value, "/", vbTextCompare)
               
          '#
          '# isolate the domain name
          '#
               If pvt_int_FindCharacter > 0 Then
                    pvt_str_DomainName = Left$(.Cells(pvt_lng_RowNumber, "A").Value, (pvt_int_FindCharacter - 1))
               Else
                    pvt_str_DomainName = .Cells(pvt_lng_RowNumber, "A").Value
               End If
                    
          '#
          '# only process the domain if the extension is in a list of provided extensions
          '#
               pvt_str_Extension = Mid$(pvt_str_DomainName, (InStr(1, pvt_str_DomainName, ".") - 1))
               If InStr(1, ".com.net.info.org.edu", pvt_str_Extension, vbTextCompare) > 0 Then
               
               '#
               '# add an entry to the dictionary object used to count occurences if this is the first occurence
               '# of the domain
               '#
                    If Not pvt_dct_Domain.Exists(pvt_str_DomainName) Then
                         pvt_dct_Domain.Add pvt_str_DomainName, 0
                    End If
               
               '#
               '# raise the occurence counter and output the full url when the domain has been encountered
               '# <= 3 times
               '#
                    pvt_dct_Domain.Item(pvt_str_DomainName) = pvt_dct_Domain.Item(pvt_str_DomainName) + 1
                    If pvt_dct_Domain.Item(pvt_str_DomainName) < 4 Then
                         pvt_lng_TargetRow = pvt_lng_TargetRow + 1
                         .Cells(pvt_lng_TargetRow, "B").Value = .Cells(pvt_lng_RowNumber, "A").Value
                    End If 'counter <= 3
               End If 'valid extension
               
          Next pvt_lng_RowNumber
     End With

End Sub

Originally Posted by sami770

does not work

Sami, while I have tested it myself without any problems using your own example data and I do appreciate feedback, a bit more information than "does not work" would be appreciated.

still looking for a solution that support the 5 domain types i specified...

@nilem, as long as the entries are sorted alphabetically that would work too. Your solution does not check on a valid extension though, but I am not sure whether that is really required.

Why don't you provide a copy of the work with the example data and my code so I can check why it does not work?

Sam,

I found a typing error. Please change the statement below

pvt_str_Extension = Mid$(pvt_str_DomainName, (InStr(1, pvt_str_DomainName, ".") - 1))

to

pvt_str_Extension = Mid$(pvt_str_DomainName, (InStr(1, pvt_str_DomainName, ".")))

apologies

Your post does not comply with Rule 12 of our Forum RULES. Don't quote whole posts -- it's just clutter. If you are responding to a post out of sequence, limit quoted content to a few relevant lines that makes clear to whom and what you are responding.

@protonLeah

Give the kid a break...I just hammered her!

Sam,

the statement attempts to find the extension part of the domain name. If it returns an error then I assume you have domain names without an extension.

replace the single statement by:

     pvt_str_Extension = vbNullString
     If InStr(1, pvt_str_DomainName, ".") > 0 Then
          pvt_str_Extension = Mid$(pvt_str_DomainName, InStr(1, pvt_str_DomainName, "."))
     End If

Sam,

Many things were wrong with the code as it did not expect (or check for) http://, https:// prefixes and it also expected the data to start on row 2 as per your previous example. Please check the enclosed workbook

Originally Posted by sami770

PERFECT, SIMPLY PERFECT
Thank you so much for your time and efforts, I do appreciate it!

You are very welcome. Please mark your thread as SOLVED when you have a moment.