highlight duplicate rows comparing two cells

P

pgcn

I've seen many posts using one column and how to use the advanced
filter but I don't think you can use them with two columns of info.

My s/s (often +1000 records) has col C LastName & col D FirstName with
other supporting details e.g. address, email of stakeholders. Many
times there are the same surnames but with the same or different
firstnames.

Can someone please help with some code to highlight the Last & First
names of rows that are duplicated (have the same last & first names).
I do not want them hidden or deleted.

Thanks so much.

Peta
 
D

Dave Peterson

You can use multiple columns and get a list of unique combinations of those
columns.

You may want to post what failed when you tried it.
 
P

pgcn

You can use multiple columns and get a list of unique combinations of those
columns.

You may want to post what failed when you tried it.











--

Dave Peterson- Hide quoted text -

- Show quoted text -

I got this base code from a posting but have butchered it and can't
find the original post again. I don't really understand it so not sure
if it's even close to what I want to do. I want all occurances of
where the first and last names are the same to be highlighted please
and placed at the top of the s/s. I don't want to concatenate and
advance filter as I want to be able to quickly search all records when
deciding which duplicate to delete or to keep both/all (other columns
may differ).

Sub ShowPetaHerDuplicates()
'Application.ScreenUpdating = False
Range("a:a").EntireColumn.Insert
Range("a1").Value = "Key"
Range("b1").Value = "Count"
Range("a2").FormulaR1C1 = "=RC[5]&RC[6]"
Range("b2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("a2:b2").AutoFill _
Destination:=Range("e2:f2" & Range("C65536").End(xlUp).Row)
Range("b:b").AutoFilter Field:=1, Criteria1:=">1"
If Range("b1").CurrentRegion.Columns(2).SpecialCells _
(xlCellTypeVisible).Cells.Count > 1 Then
Application.ScreenUpdating = True
MsgBox "There are duplicated values"
Else
Range("a:b").EntireColumn.Delete
Application.ScreenUpdating = True
MsgBox "There were no duplicated values"
End If
End Sub

thanks a lot
Peta
 
D

Dave Peterson

I don't see where you tried the .advancedfilter technique.

But this seemed to work ok for me:

Option Explicit
Sub testme01()

Dim myRng As Range
Dim wks As Worksheet
Dim TotalRows As Long
Dim HowManyVisibleRows As Long

Set wks = ActiveSheet

With wks
Set myRng = .Range("C1:d" & .Cells(.Rows.Count, "C").End(xlUp).Row)
TotalRows = myRng.Columns(1).Cells.Count
If .FilterMode Then
.ShowAllData
End If

myRng.AdvancedFilter _
Action:=xlFilterInPlace, Unique:=True

HowManyVisibleRows = myRng.Columns(1).Cells _
.SpecialCells(xlCellTypeVisible).Cells.Count

If .FilterMode Then
.ShowAllData
End If

End With

If TotalRows <> HowManyVisibleRows Then
MsgBox "Duplicates"
Else
MsgBox "No duplicates"
End If

End Sub

This assumes that there are headers in row 1 so that advancedfilter can work ok.

You can use multiple columns and get a list of unique combinations of those
columns.

You may want to post what failed when you tried it.











--

Dave Peterson- Hide quoted text -

- Show quoted text -

I got this base code from a posting but have butchered it and can't
find the original post again. I don't really understand it so not sure
if it's even close to what I want to do. I want all occurances of
where the first and last names are the same to be highlighted please
and placed at the top of the s/s. I don't want to concatenate and
advance filter as I want to be able to quickly search all records when
deciding which duplicate to delete or to keep both/all (other columns
may differ).

Sub ShowPetaHerDuplicates()
'Application.ScreenUpdating = False
Range("a:a").EntireColumn.Insert
Range("a1").Value = "Key"
Range("b1").Value = "Count"
Range("a2").FormulaR1C1 = "=RC[5]&RC[6]"
Range("b2").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
Range("a2:b2").AutoFill _
Destination:=Range("e2:f2" & Range("C65536").End(xlUp).Row)
Range("b:b").AutoFilter Field:=1, Criteria1:=">1"
If Range("b1").CurrentRegion.Columns(2).SpecialCells _
(xlCellTypeVisible).Cells.Count > 1 Then
Application.ScreenUpdating = True
MsgBox "There are duplicated values"
Else
Range("a:b").EntireColumn.Delete
Application.ScreenUpdating = True
MsgBox "There were no duplicated values"
End If
End Sub

thanks a lot
Peta
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top