Parsing and Counting Text Data?

[guyfromva]

Any thoughts on how I can parse and count the frequency of data in this format:


Control Names
123 Pryor, Mark; Bingaman, Jeff; Portman, Rob
345 Portman, Rob; Warner, Mark; Kyl, John
567 Pryor, Mark; Inhofe, Jim
324 Reid, Harry
234 Corker, Bob
765 Brown, Sherrod; Schumer, Chuck; Reid, Harry

to this...

Frequency Name
2 Pryor, Mark
1 Bingaman, Jeff
2 Portman, Rob
1 Warner, Mark
1 Kyl, John
1 Inhofe, Jim
2 Reid Harry
1 Corker, Bob
1 Brown, Sherrod
1 Schumer, Chuck

(formating is weird, but the numbers in each of the 2 examples are contained in a separate column)

Thanks!

[Cutter]

I would try Data - Text to Columns on the original list using the ; as the delimiter.
That will give a series of columns with names.
You can then sort each of those columns and then cut paste the 2nd & 3rd, etc. below the first.
Make a copy of that new list and on the copy do a Data - Remove Duplicates.
Now you have a list of all names and a list of unique names.
Use a COUNTIF() using the All Names list as the range and the Unique List as the search values.

[Palmetto]

See attached. Adjust code to suit.

Option Explicit

Sub Parse_Count()

    Dim lastrow As Long, nextrow As Long, lastcolumn As Long, i As Long
    Dim rngList As Range
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set rngList = Range("A1:A" & lastrow)
    Range("C1") = "Name"
    nextrow = 2
    
    Application.ScreenUpdating = False
    
    rngList.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        Semicolon:=True
            
    For i = 1 To lastrow Step 1
        nextrow = Cells(Rows.Count, "C").End(xlUp).Row + 1
        lastcolumn = Cells(i, Columns.Count).End(xlToLeft).Column
        Range(Cells(i, "G"), Cells(i, lastcolumn)).Copy
        Range("C" & nextrow).PasteSpecial Transpose:=True
    Next i
         
    Range("G1", Cells(lastrow, lastcolumn)).ClearContents
    
    lastrow = Cells(Rows.Count, "C").End(xlUp).Row
    
    Range("C1:C" & lastrow).AdvancedFilter Action:=xlFilterCopy, Copytorange:=Range("E1"), unique:=True
    
    Range("D1") = "Count"
    Range("D2").Formula = "=Countif($C$2:$C" & lastrow & ",E2)"
    Range("D2").AutoFill Destination:=Range("D2:D" & lastrow)
         
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
         
    Set rngList = Nothing

End Sub