Spreadsheet Fun

SpicyCrab · 10-26-2009, 03:39 PM

Sorry if this is the wrong forum for this, I can't find one that fits it better.

Firstly, hello every one, I am new here. I have encountered a little conundrum.

Alrighty, so I have a .csv spreadsheet which is one column of data; web addresses, in the following format.

Quote:

"http://personal-finance-software-review.toptenreviews.com/"
"http://personal-finance-software-review.toptenreviews.com/microsoft-money-deluxe-review.html"
"http://www.washingtonpost.com/wp-dyn/content/article/2009/07/17/AR2009071703851.html"
"http://news.cnet.com/8301-13860_3-10261742-56.html"
"http://www.christianpf.com/best-free-personal-finance-software/"
"http://www.getrichslowly.org/blog/2009/07/01/good-bye-microsoft-money-16-powerful-personal-finance-programs/"
"http://www.mint.com/"
"http://www.mybanktracker.com/bank-news/2009/08/10/top-5-personal-finance-software-that-helps-to-save-money/"

there are over 2000 entries. I would like to parse through these entries and find

A) The actual addresses that are most common (www.x.com/blablabla.html)

B) The domains that are most common (www.x.com)

Any ideas on how to do this quickly and efficiently?

venkat1926 · 11-22-2009, 01:18 AM

I copied the urls WITHOUT DOUBLE QUOTE in column A from A1 down.

Then I wrote a few macros and combined them in one overall macro.
the macros are given below
the macro is using splitting the url by text to columns and copied from column B to right.
Then the macro finds out the no. of occasions each text occurs and find out the max no. of occurrence and that is the common occurrence you can go throug the macros to follow my logic.

I AM NOT SURE WHETHER THIS IS QUICK OR EFFICIENT. But it seems to work

assumptions
1. The splitting(text to columns) of the url does not run more than the column I as I am doing something in column J in the "sub" macro "findcommondomain".
2. when urls are entered in A1 down there should not be any gap and the url entries should not have the double quotes
IT IS ENOUsGH IF you RUN THE MACRO "macrooverall". Other sub macro must be in the vbeditor in the same module.

If there is any bug post the code line where there is trouble and the error message.

The macros are

Code:

Sub findcommonurl()
Dim j As Integer, k As Integer, r As Range
Dim m(1 To 8) As Integer, x As String, y(1 To 8) As String
Dim z
j = Range("A1").End(xlDown).Row
Set r = Range(Range("A1"), Range("A1").End(xlDown))
For k = 1 To j
x = Cells(k, "A").Value
m(k) = WorksheetFunction.CountIf(r, x)
'MsgBox m(k)
y(k) = x
Next k
z = WorksheetFunction.Max(m)
MsgBox "common url is " & " " & y(z)
End Sub

Code:

Sub texttocolA()
Dim r As Range
Set r = Range(Range("A1"), Range("A1").End(xlDown))
r.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
        OtherChar:="/", FieldInfo:=Array(Array(0, 1), Array(7, 1)), _
        TrailingMinusNumbers:=True
     
 
End Sub

Code:

Sub texttocolC()
Dim r  As Range
Set r = Range(Range("C1"), Range("c1").End(xlDown))

    r.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=".", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
Range(Range("a1"), Range("a1").End(xlToRight)).EntireColumn.AutoFit
End Sub

Code:

Sub findcommondomain()
Dim j As Integer, k As Integer, r As Range
Dim m(1 To 8) As Integer, x As String, y(1 To 8) As String
Dim z
j = Range("C1").End(xlDown).Row
Set r = Range(Range("c1"), Range("c1").End(xlDown))
For k = 1 To j
x = Cells(k, "c").Value & "." & Cells(k, "c").End(xlToRight).Value
'MsgBox x
Cells(k, "j") = x
Next k
Set r = Range(Range("J1"), Range("J1").End(xlDown))
For k = 1 To j
x = Cells(k, "J")
m(k) = WorksheetFunction.CountIf(r, x)
'MsgBox m(k)
y(k) = x
Next k

z = WorksheetFunction.Max(m)
'MsgBox z
If z > 1 Then
MsgBox "coomon domain is " & " " & y(z)
Else
MsgBox "no common domain"
End If
End Sub

Code:

Sub macrooverall()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("B1:J1").EntireColumn.Delete
texttocolA
texttocolC
findcommonurl
findcommondomain
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub