VBA Delete duplicate cells from a range then highlight original

[decadence]

Hi, Is it possible to Delete all duplicate cells from a varied range but keeping the original string and highlight it?

I will have up to 10 Columns and up to 30000 rows of data which will contain multiple duplicates strings that need removing, There will also be headers. Can anyone Help? Thanks

Example:

From This

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Header1
[/TD]
[TD]Header2
[/TD]
[TD]Header3
[/TD]
[TD]Header4
[/TD]
[TD]Header5
[/TD]
[/TR]
[TR]
[TD]Apple
[/TD]
[TD]Apple
[/TD]
[TD]Banana
[/TD]
[TD]Orange
[/TD]
[TD]Pear
[/TD]
[/TR]
[TR]
[TD]Banana
[/TD]
[TD]Banana
[/TD]
[TD]Pear
[/TD]
[TD]Orange
[/TD]
[TD]Apple
[/TD]
[/TR]
[TR]
[TD]Apple
[/TD]
[TD]Pear
[/TD]
[TD]Orange
[/TD]
[TD]Orange
[/TD]
[TD]Banana
[/TD]
[/TR]
[TR]
[TD]Pear
[/TD]
[TD]Apple
[/TD]
[TD]Banana
[/TD]
[TD]Pear
[/TD]
[TD]Orange
[/TD]
[/TR]
</tbody>[/TABLE]

To This But Highlight the remaining original duplicates

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Header1
[/TD]
[TD]Header2
[/TD]
[TD]Header3
[/TD]
[TD]Header4
[/TD]
[TD]Header5
[/TD]
[/TR]
[TR]
[TD]Apple
[/TD]
[TD][/TD]
[TD]Banana
[/TD]
[TD]Orange
[/TD]
[TD]Pear
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[MickG]

Try this:-
NB:- Update !!!

[COLOR="Navy"]Sub[/COLOR] MG16Jul22
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Cells(1).CurrentRegion
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Not .Exists(Ray(n, Ac)) [COLOR="Navy"]Then[/COLOR]
            .Add Ray(n, Ac), Ray(n, Ac)
        [COLOR="Navy"]Else[/COLOR]
          Ray(n, Ac) = ""
        [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n

[COLOR="Navy"]With[/COLOR] Range("A1").Resize(UBound(Ray, 1), UBound(Ray, 2))
    .Value = Ray
    .SpecialCells(xlCellTypeConstants).Interior.Color = vbYellow
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[decadence]

Thank you MickG this is perfect

 

[MickG]

You're welcome