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

does not work

Originally Posted by OllieB

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