Identifying Duplicate Values Code Modification Help

[Guest]

In VBA code I would like to check a colum of values for uniqueness.
Basically, I want to loop through the column and write duplicate instances to
an error file.

From the table example listed below:

Row Num column
1 123
2 124
3 123
4 3
5 123
6 456
7 456
8 sdfg
9 12345
10 sdfg
11 sdfg

My result set should look like:

Row Error Description
1 123 duplicate record
3 123 duplicate record
5 123 duplicate record
6 456 duplicate record
7 456 duplicate record
8 sdfg duplicate record
10 sdfg duplicate record
11 sdfg duplicate record

However, the result set I'm getting is only searching for the first value.

1 123 duplicate record
3 123 duplicate record
5 123 duplicate record

The code I'm using is listed below:

Public Sub a000000000000dupsearchrev()

Dim dupval As String
Dim curval As String
Dim rownum As String
Dim varMstrSrch()
Dim searchval As String
Dim i As Integer
Dim ubnd As Long

Sheets("master").Activate
varMstrSrch() = Range("b2:b17") '65536") ' Read it in
Range("b2").Select
Do Until IsEmpty(ActiveCell)
dupval = ActiveCell
searchval = dupval 'this is the value we are seeking
For i = LBound(varMstrSrch()) To UBound(varMstrSrch())
ubnd = UBound(varMstrSrch())
If varMstrSrch(i, 1) = searchval Then
curval = ActiveCell
rownum = ActiveCell.Offset(0, -1)
Sheets("DataEntry-Errors").Activate
ActiveCell = rownum
ActiveCell.Offset(0, 1) = curval
ActiveCell.Offset(0, 2) = "duplicate record"
ActiveCell.Offset(1, 0).Select
Sheets("master").Activate
End If
ActiveCell.Offset(1, 0).Select
Next i
'ActiveCell.Offset(1, 0).Select
Loop
End Sub

If I remove the comment I get duplicate search results. Any help anyone can
offer would be greatly appreciated. Thanks in advance.

AxLa

 

[Guest]

Amazingly I wrote a duplicates macro last week - Here's the essential part of
the code:-

ActiveSheet.Name = "Duplicates"

With ActiveWorkbook.Worksheets(inputsheet)

For Counter = 1 To LastRow - 1

DupRow = 0 ' When not zero atleast one dup already found for
this 'Counter' row
'AlreadyOutput function used so triplicates don't
get repeated as dups etc

If .Cells(Counter, 5) <> "" And Not AlreadyOutput(Counter) Then

CompNI = .Cells(Counter, 5)

For CompCounter = Counter + 1 To LastRow

If .Cells(CompCounter, 5) = CompNI Then

If DupRow = 0 Then
.Rows(Counter).Copy
Destination:=ActiveSheet.Rows(OutRow)
Cells(OutRow, 6) = .Cells(Counter, 6)
DupRow = CompCounter
Cells(OutRow, 8) = Counter ' Where this data is
in orig input sheet
OutRow = OutRow + 1
End If

.Rows(CompCounter).Copy
Destination:=ActiveSheet.Rows(OutRow)
Cells(OutRow, 6) = .Cells(CompCounter, 6)
Cells(OutRow, 8) = CompCounter 'Where this data is
in orig input sheet
OutRow = OutRow + 1

End If

Next CompCounter

End If

Next Counter

End With

SORRY YOU'LL ALSO NEED THE alreadyoutput function to make it nice - I Was
looking for duplicate NI numbers :-

Function AlreadyOutput(InRowNo As Long) As Boolean

Dim found As Boolean
Dim RowNo As Integer
Dim LastRow As Integer

found = False
RowNo = 1
LastRow =
ActiveWorkbook.Worksheets("Duplicates").Cells.SpecialCells(xlCellTypeLastCell).Row

With ActiveWorkbook.Worksheets("Duplicates")

While RowNo <= LastRow And Not found

If .Cells(RowNo, 8) = InRowNo Then
found = True
End If

RowNo = RowNo + 1
Wend

End With

AlreadyOutput = found

End Function

 

[Guest]

John,

Thank you. I'll test it out to see if I can make it work. Thanks again.

AxLa

 

[Guest]

John,

I tried to implement your code but I'm getting the error message listed below:

ByRef argument type mismatch

AxLa

 

[Dave Peterson]

Excel has a worksheet function that you could use in column C (and drag down):

=if(countif($b$2:$b$17,b2)>1,"duplicate record","")

Then you could apply data|filter|autofilter to see just the duplicates.


As a macro:

Option Explicit
Sub testme()

Dim myRng As Range
Dim myCell As Range
Dim mstrWks As Worksheet
Dim rptWks As Worksheet
Dim oRow As Long

Set mstrWks = Worksheets("master")
Set rptWks = Worksheets.Add

With mstrWks
Set myRng = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
End With

rptWks.Range("a1").Resize(1, 3).Value _
= Array("Row#", "Value", "Message")

oRow = 2
For Each myCell In myRng.Cells
If Application.CountIf(myRng, myCell.Value) > 1 Then
With rptWks
.Cells(oRow, "A").Value = myCell.Row
.Cells(oRow, "B").Value = myCell.Value
.Cells(oRow, "C").Value = "duplicate record"
End With
oRow = oRow + 1
End If
Next myCell

End Sub

And you may want to take a look at Chip Pearson's site.
He has a bunch of techniques for working with duplicates at:
http://www.cpearson.com/excel/duplicat.htm

 

[Guest]

Dave,

"You are truly powerful, as the emperor has foreseen"

Thank you very much, with a slight modification this worked perfectly. In
the workbook I'm using I have a standard "Errors" worksheet I reuse, so I set
the rptWks value to the Errors worksheet and it does exactly what I need it
to do. Thanks again.

AxLa

 

[Dave Peterson]

er, glad I could help.

Dave,

"You are truly powerful, as the emperor has foreseen"

Thank you very much, with a slight modification this worked perfectly. In
the workbook I'm using I have a standard "Errors" worksheet I reuse, so I set
the rptWks value to the Errors worksheet and it does exactly what I need it
to do. Thanks again.

AxLa