Remove duplicates

Hi,

I am using the below code(extracted from internet)-

Function combineRange(ParamArray theRanges() As Variant) As Variant()
    Dim totalColumns As Long, z As Long, r As Long, g As Long, aCell As Range
    
    ReDim zRanges(0) As Range
    For r = LBound(theRanges) To UBound(theRanges)
        ReDim Preserve zRanges(r)
        Set zRanges(r) = theRanges(r)
        Set zRanges(r) = Intersect(zRanges(r), zRanges(r).Worksheet.UsedRange)
       
        totalColumns = Application.WorksheetFunction.Max(zRanges(r).Columns.Count, totalColumns)
    Next r
    
    r = 1
    
    ReDim theRay(1 To totalColumns, 1 To r)
    
    For z = LBound(zRanges) To UBound(zRanges)
        For Each aCell In zRanges(z).Columns(1).Cells
           ReDim Preserve theRay(1 To totalColumns, 1 To r)
            For g = 1 To zRanges(z).Columns.Count
                theRay(g, r) = aCell.Offset(0, g - 1).Value
            Next g
            r = r + 1
        Next aCell
    Next z
    
    combineRange = Application.WorksheetFunction.Transpose(theRay)
End Function

I think that it works fine for stacking/flattening data of multiple columns in multiple worksheet.
Then I use the function

SORT(UNIQUE(combineRange(LA!C6:C1267,PI!C6:C533,MI!C6:C275,Aj!C6:C132)))

It then further gets sorted and alphabetically arranged in which there are duplicates but in different form.e.g

A Grade Sun Korce P Ltd (605955053)
A Grade Sun Korces [P] Ltd (605951053)
A.G. He Ind (P) Ltd, Bhairaine (803459699)
A.G. Hya Ind. (P) Ltd. (803459699)
B & B International Trading (B.& B. International Trading Pvt.Ltd,Phara)
Pace Maa Pack Ud 855656316 (855656316)
Subhkamna Store
Aakash Foods Products,(902844607)Kh (902844607)
Aakash Foods Products,Kise (902844607)
)

What I want is that I want to retain only one.So,I want automatically to get one out of two. Duplicates is to be identified on the basis of number which matches irrespective of spelling mistake or typo in different sheet.

How this can be done into a single function of vba or any other.

I'd focus on this option

Originally Posted by paradise2sr

or any other.

A good tool for it could be Power Query.
At first I prepared a longer version (will give it below just for reference), but then the shorter:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"rawdata", type nullable text}}),
    #"Added Custom" = Table.AddFuzzyClusterColumn(#"Changed Type", "rawdata", "fuzzygrouped",  [IgnoreCase = true, IgnoreSpace = true, Threshold=0.5]),
    #"Left only the same" = Table.ReplaceValue(#"Added Custom" ,each [rawdata],each if [rawdata] = [fuzzygrouped] then [rawdata] else null,Replacer.ReplaceValue,{"rawdata"}),
    #"Removed Columns" = Table.RemoveColumns(#"Left only the same",{"fuzzygrouped"}),
    #"Removed Blank Rows" = Table.SelectRows(#"Removed Columns", each not List.IsEmpty(List.RemoveMatchingItems(Record.FieldValues(_), {"", null})))
in
    #"Removed Blank Rows"

Changed type step is important, as fuzzy logic will not work with non-text data.

You can experiment with Threshold value. If this parameter is ommitted, (or equal default 0.8) then two last entries are not recognized as one, so I used lower one: 0.5 and for sample data is a good one.

Both queries are used in attached file. And as said before, second (the one I started with) query for reference:

let
    TableSource = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Changed_Type = Table.TransformColumnTypes(TableSource,{{"rawdata", type text}}),
    Source = Table.FuzzyNestedJoin(Changed_Type, {"rawdata"}, Changed_Type, {"rawdata"}, "Changed_Type", JoinKind.LeftOuter, [IgnoreCase=true, IgnoreSpace=true, Threshold=0.5]),

//Function to transform table into only first (as sorted) row 
    Leave_only_first = (ATable as table) as table =>
    let
        #"Sorted Rows" = Table.Sort(ATable,{{"rawdata", Order.Ascending}}),
        #"Kept First Rows" = Table.FirstN(#"Sorted Rows",1)
    in
        #"Kept First Rows",
//Applying function
    The_Result = Table.TransformColumns(Source,{"Changed_Type", each Leave_only_first(_)}),
    #"Expanded Table1" = Table.ExpandTableColumn(The_Result, "Changed_Type", {"rawdata"}, {"Table1.rawdata"}),
    #"Added Conditional Column" = Table.AddColumn(#"Expanded Table1", "Custom", each if [rawdata] = [Table1.rawdata] then true else null),
    #"Filtered Rows" = Table.SelectRows(#"Added Conditional Column", each ([Custom] = true)),
    #"Removed Columns" = Table.RemoveColumns(#"Filtered Rows",{"Table1.rawdata", "Custom"})
in
    #"Removed Columns"

PS. And if needed, the list of removed duplicates could be obtained with similar query:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"rawdata", type nullable text}}),
    #"Added Custom" = Table.AddFuzzyClusterColumn(#"Changed Type", "rawdata", "assigned_to",  [IgnoreCase = true, IgnoreSpace = true, Threshold=0.5]),
    #"Grouped Rows" = Table.Group(#"Added Custom", {"assigned_to"}, {{"All_values", each _, type table [rawdata=nullable text, assigned_to=text]}}),
    #"Expanded All_values" = Table.ExpandTableColumn(#"Grouped Rows", "All_values", {"rawdata"}, {"rawdata"}),
    #"Left only different" = Table.ReplaceValue(#"Expanded All_values" ,each [rawdata],each if [rawdata] <> [assigned_to] then [rawdata] else null,Replacer.ReplaceValue,{"rawdata"}),
    #"Filtered Rows" = Table.SelectRows(#"Left only different", each ([rawdata] <> null))
in
    #"Filtered Rows"

Thanx for the kind response. Actually ,I hesitate to use PQ as my data would be changing very frequently adding and deletion.And this result is linked to some other data.This kind of real life problem I am facing during data analysis.

I would be please to let you know.

Just a personal opinion:
PQ is perfect for situation when data is "changing very frequently by adding and deletion"
You (0r macro) change(s) data. Then either manualy right click on the table produced by PQ, select refresh Query and ... here it is. Or, to avoid right click and manual refresh, one couuld use an event handler for Worksheet_Change event to call refreshing. If you would like to focus on fuzzy match just in macro, you can google for fuzzy match cartesian product but the algorithms here are rather long (in terms of code), and (what's worse) quite computing power/time hungry and not so easy to implement. While PQ does it all almost in no time with just a little bit of code.

Hi,

Thanx once again for your kind respose.

Have you seen my another post at https://www.excelforum.com/excel-pro...lly-order.html

The result seems as per your post #2 attachment seems to be fine but not tested on large data which I am dealing.I will test and let you know accordingly what problems I am facing.You can let me know the stepwise step for getting the result.

Can you try in the sample workbook in the link stated.

Make sure your data is in Excel table.

You may add an empty lina in row 1 of my file and copy your data into my file. And then just make sure the table (now starting in A2 extends down to end of your data

Unfortunately it is not easy to diagnose the problem if you do not show the file. It does not have to be real one. But something following the layout and format.
Have you tried to right click on result table (green one) and choose "Refresh" from the pop-up context menu?