Summary Report

The only way that I see is building a macro for that Sid, with formulas it won't go...

i feel a pivot table & then some concatenate functions will do ..

@JP: Hmm I thought so too. Do you have a sample code ready?

kishoreb123: Umm, That will be messy. The file that I have has 9 million records :)

Sid

One logic that I thought of following is [It's messier again :( ]

1) Looping through every cell and storing the value in an array by splitting it using SPACE as delimiter
2) Compare it with the next cell (The next cell also goes in an array using delim as SPACE). So basically comparing two arrays

Like I mentioned it is very messy. Any better solution?

Sid

My suggestion:

1) Build a Pivot Table with the data to get the Names, Countries and Counts, like the attached image.
2) Build a macro to go through all of the lines on the Pivot Tables and build your output table

Hope you understand the logics.

jppinto
Capturar.JPG

So basically it is the same thing what I suggested in my last post. Instead of looping through every cell in the first column of the Sheet, I now would be looping through the first column of Pivot and still use 2 arrays (as I mentioned above) to do the comparisons?

Sid

Also like I mentioned above, the file has approx 9 millions rows so it is quite heavy. Wouldn't a Pivot make it even more heavier? My original plan was to delete the rows after creating the report...

Sid

Let me check...I'm trying to get a solution done here. Wait a bit...

...the file has approx 9 millions rows...

And you are using excel for this?

Majboori hai ssaqibh Bhai :(

I have to use Excel.

Sid

I just can't make the VBA code to work! VBA is not my strongest point! :(

The ideia is, as I said, build the pivot table like I mentioned before. Then build the VBA code to go through each person's Name and build a string with each Country childitem of that PivotItem with also the Total number, separated by " | ", like you wanted, but I can't get it to work.

As VBA is your favorite part of Excel, can you try to build the code for that?

jppinto

I already have started on that :)

Sid

Ok part 1 achieved!!! :)

See if you or anyone else can improve on this code. If not then I will close this question...

Paste this in a module.

Option Explicit

Sub Sample()
    Dim SI As String
    
    SI = "Siddharth Rout | David Miller | Kumar Pradeep | Rout Siddharth | Kevin Jones | Miller David | Jones Kevin | Pradeep Kumar"
    
    '~~> Expected Output
    Debug.Print CheckNames(SI)
    'Siddharth Rout | David Miller | Kumar Pradeep | Kevin Jones
    
End Sub

Function CheckNames(strInput As String) As String
    Dim PipeA() As String, SpaceA() As String, SpaceB() As String
    Dim clearItem As Boolean, i As Long, j As Long, k As Long
    Dim strtemp As String
    
    PipeA = Split(strInput, "|")
    
    '~~> Remove Spaces
    For i = 0 To UBound(PipeA)
        PipeA(i) = Trim(PipeA(i))
    Next i
    
    '~~> Loop 1 through the array
    For i = 0 To UBound(PipeA)
        If Len(Trim(PipeA(i))) <> 0 Then
            '~~> Loop 2 through the array
            For j = 0 To UBound(PipeA)
                If i <> j Then
                    '~~> Check for Space and if found in both instances then possibility of a match
                    If InStr(1, PipeA(i), " ", vbTextCompare) > 0 And InStr(1, PipeA(j), " ", vbTextCompare) > 0 Then
                        SpaceA = Split(PipeA(i), " ")
                        SpaceB = Split(PipeA(j), " ")
                        '~~> If ubound is same then possibility of a match
                        If UBound(SpaceA) = UBound(SpaceB) Then
                            '~~> Check for each word in the other array
                            For k = 0 To UBound(SpaceA)
                                If k <> i Then
                                    If InStr(1, PipeA(j), SpaceA(k), vbTextCompare) Then
                                        clearItem = True
                                    Else
                                        '~~> Even if one word is different then NO MATCH
                                        clearItem = False
                                    End If
                                End If
                            Next k
                            '~~> If match found then clear the Array Item
                            If clearItem = True Then PipeA(j) = ""
                            
                            clearItem = False
                        End If
                    '~~> Since no Space do a direct Match
                    ElseIf UCase(PipeA(i)) = UCase(PipeA(j)) Then
                        '~~> If match found then clear the Array Item
                        PipeA(j) = ""
                    End If
                End If
            Next j
        End If
    Next i
    
    '~~> loop Through Array and Combine, omitting the blank cells
    For i = 0 To UBound(PipeA)
        If PipeA(i) <> "" Then strtemp = strtemp & " | " & PipeA(i)
    Next
    
    CheckNames = Mid(strtemp, 4)
End Function

Select allOpen in new window

Sid

sdwalker: Sorry just saw your post.

Let me go through it.

Sid

Fantastic sdwalker! :)

I will take it on from here :)

Sid