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

Header1	Header2	Header3	Header4	Header5
Apple	Apple	Banana	Orange	Pear
Banana	Banana	Pear	Orange	Apple
Apple	Pear	Orange	Orange	Banana
Pear	Apple	Banana	Pear	Orange

<tbody>
</tbody>

To This But Highlight the remaining original duplicates

Header1	Header2	Header3	Header4	Header5
Apple		Banana	Orange	Pear

<tbody>
</tbody>

 

[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