Remove duplicates and merge rows-macro

[Annie1986]

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]MaryP[/TD]
[TD]123[/TD]
[TD]street1,street2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]James S[/TD]
[TD]123[/TD]
[TD]street1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]Mary P[/TD]
[TD]123[/TD]
[TD]street1[/TD]
[TD]2.8[/TD]
[/TR]
[TR]
[TD]2002[/TD]
[TD]James S[/TD]
[TD]abc[/TD]
[TD]street1,street2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2003[/TD]
[TD]Mary P[/TD]
[TD]abc[/TD]
[TD]street3,street4[/TD]
[TD]1.8[/TD]
[/TR]
</tbody>[/TABLE]

I have above data in excel.I have to select row1 and row3 as duplicates,as Column B name is same instead of the space,Column A and Column C are same and column D is similar.Then I need to collect most and correct details and merge into 1 row

Expected result is
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]Mary P[/TD]
[TD]123[/TD]
[TD]street1,street2[/TD]
[TD]2.8[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]James S[/TD]
[TD]123[/TD]
[TD]street1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2002[/TD]
[TD]James S[/TD]
[TD]abc[/TD]
[TD]street1,street2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2003[/TD]
[TD]Mary P[/TD]
[TD]abc[/TD]
[TD]street3,street4[/TD]
[TD]1.8[/TD]
[/TR]
</tbody>[/TABLE]

Most and correct details
Correct Name- Mary P(with space)
Longest column D-street1,street2
Data in column E-2.8


Please suggest a macro as the number of rows is quite large.

 

[MickG]

If column "B" has Inaccurately spelt names, what other Inaccuracies can be expected, and is it possible to check the names against a known data base before any code is used to meet you thread requirements.

 

[Annie1986]

If column "B" has Inaccurately spelt names, what other Inaccuracies can be expected, and is it possible to check the names against a known data base before any code is used to meet you thread requirements.

I do not have known data base.I will have to see and understand it is duplicates.Other inaccuracy is ,the names can come with first part.In that case Mary P and Mary are same.

 

[jsotola]

"Mary P"  and "MaryP" are different

the two are similar though

what about "Mary" and "Maury"

those are also similar

if this is for a production environment then you cannot assume the two as being same

you could flag them for manual review

 

[Annie1986]

There wont be spelling errors.As far as I noted,either there wont be space between the first and the second part or the second part will be missing.

 

[Annie1986]

"Mary P"  and "MaryP" are different

the two are similar though

what about "Mary" and "Maury"

those are also similar

if this is for a production environment then you cannot assume the two as being same

you could flag them for manual review

There wont be spelling errors.As far as I noted,either there wont be space between the first and the second part or the second part will be missing.

 

[MickG]

Would it be acceptable to base the criteria on:- column "A", the first 4 characters in column "B" , and column "C"

 

[Annie1986]

Would it be acceptable to base the criteria on:- column "A", the first 4 characters in column "B" , and column "C"

column "A", the first 4 characters in column "B" ,column "C" and similar column D(some thing like most of the characters are same in column D)
There are times when A,B,C are same but description(column D) differs. Then they are not duplicates

 

[MickG]

Try this:-
Results start sheet2 "A2".

[COLOR="Navy"]Sub[/COLOR] MG21Dec20
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oTx         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q           [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Astr        [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    oTx = Dn & "," & Replace(Dn.Offset(, 1), " ", "") & "," & Dn.Offset(, 2)
      [COLOR="Navy"]If[/COLOR] Not .Exists(oTx) [COLOR="Navy"]Then[/COLOR]
           .Add oTx, Array(Dn, "")
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(oTx)
            Q(1) = IIf(InStr(Dn.Offset(, 1), " "), Dn.Offset(, 1), Q(1))
            [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
           .Item(oTx) = Q
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K       [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] G       [COLOR="Navy"]As[/COLOR] Variant
 
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
ReDim ray(1 To .Count, 1 To 5)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    c = c + 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] G [COLOR="Navy"]In[/COLOR] .Item(K)(0)
        [COLOR="Navy"]For[/COLOR] n = 1 To 5
            [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] n
                [COLOR="Navy"]Case[/COLOR] 2: ray(c, n) = IIf(.Item(K)(1) > "", .Item(K)(1), .Item(K)(0).Offset(, n - 1))
                [COLOR="Navy"]Case[/COLOR] 4
                    Astr = Split(G.Offset(, 3), ",")
                        [COLOR="Navy"]For[/COLOR] Ac = 0 To UBound(Astr)
                            Dic(Astr(Ac)) = Empty
                        [COLOR="Navy"]Next[/COLOR] Ac
                        ray(c, n) = Join(Dic.keys, ", ")
                [COLOR="Navy"]Case[/COLOR] 5: ray(c, n) = ray(c, n) + G.Offset(, n - 1)
                [COLOR="Navy"]Case[/COLOR] Else: ray(c, n) = G.Offset(, n - 1)
            [COLOR="Navy"]End[/COLOR] Select
        [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] G
Dic.RemoveAll
[COLOR="Navy"]Next[/COLOR] K
Sheets("Sheet2").Range("A2").Resize(.Count, 5) = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick