Combining duplicates and replacing blanks

[ur_friend_mac]

Hello everyone!


I have after searching a while, and writing this post a few times due to browser issues, come to seek help.


I'm looking for a way (VBA or other) to combine duplicate rows while merging data streching over multiple columns. Not to sum the values, but to remove any duplicate (or blank) values (and rows). The data is spread over multiple sheets but can be copied into one to make things easier. I'll try to show an example below, please feel free to ask, as I am unsure if my goals are undestandable. The original data spreads over more columns than the example shown.


The solutions I have seen, and tried, has not achieved exactly what I'm after.


Thankful for any suggestions!

So I want this: (A2:A12)..

Item no. Shelf no. Order no. --->
[TABLE="class: grid, width: 192"]
<tbody>[TR]
[TD="width: 64, align: right"]111[/TD]
[TD="width: 64"] a[/TD]
[TD="width: 64"][/TD]
[/TR]
[TR]
[TD="align: right"]222[/TD]
[TD] b[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]333[/TD]
[TD][/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]444[/TD]
[TD][/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]222[/TD]
[TD] b[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]444[/TD]
[TD] d[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]111[/TD]
[TD][/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]333[/TD]
[TD] c[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]111[/TD]
[TD][/TD]
[TD] 1[/TD]
[/TR]
[TR]
[TD="align: right"]222[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]111[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


... To become this (order not specific):

[TABLE="class: grid, width: 192"]
<tbody>[TR]
[TD="width: 64, align: right"]111[/TD]
[TD="width: 64"] a[/TD]
[TD="width: 64, align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]222[/TD]
[TD] b[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]333[/TD]
[TD] c[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]444[/TD]
[TD] d[/TD]
[TD="align: right"]4[/TD]
[/TR]
</tbody>[/TABLE]

Have a nice day!

 

[MickG]

Run code on Data in new sheet, for results on sheet2, starting "A2".

[COLOR=navy]Sub[/COLOR] MG10Apr20
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Ray = ActiveSheet.UsedRange
ReDim nray(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
        [COLOR=navy]If[/COLOR] Not .Exists(Ray(n, 1)) [COLOR=navy]Then[/COLOR]
              c = c + 1
            [COLOR=navy]For[/COLOR] Ac = 1 To UBound(Ray, 2)
                 nray(c, Ac) = Ray(n, Ac)
            [COLOR=navy]Next[/COLOR] Ac
            .Add Ray(n, 1), c
        [COLOR=navy]Else[/COLOR]
            [COLOR=navy]For[/COLOR] Ac = 1 To UBound(Ray, 2)
                [COLOR=navy]If[/COLOR] Not IsEmpty(Ray(n, Ac)) [COLOR=navy]Then[/COLOR]
                     nray(.Item(Ray(n, 1)), Ac) = Ray(n, Ac)
                [COLOR=navy]End[/COLOR] If
            [COLOR=navy]Next[/COLOR] Ac
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] n
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A2").Resize(c, UBound(Ray, 2))
   .Value = nray
   .Columns.AutoFit
   .Borders.Weight = 2
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[ur_friend_mac]

I love you unconditionally with all my heart, Mick. Thank you.

Best wishes, Marcus

 

[MickG]

You're very welcome !!