Dave, thanks for the assistance - the way you modified the code seems to have
done the trick... although, I didnt realise it only looked for consecutive
duplicates :(. Is there a way we can further modify it so that it looks
through the entire worksheet for duplicates in that column?

Thanks for pointing that out, I didnt realise at all!

Thanks for the earlier help too.

"Dave Peterson" wrote:

Maybe...

Option Explicit
Sub FindDuplicate()
Dim kr As String
Dim ColNameIn As String
Dim A As Long
Dim FoundADuplicate As Boolean

On Error GoTo Merr

FoundADuplicate = False
ColNameIn = "C"
If Len(ColNameIn) = 0 Then
Exit Sub
End If
Range(ColNameIn & 1).Activate
For A = 1 To 200
Range(ColNameIn & A).Activate
If ActiveCell.Value = kr Then
ActiveCell.Font.Bold = True
Selection.Interior.ColorIndex = 6
FoundADuplicate = True
'if you want to stop looking after the first
'duplicate, then uncomment the next line
'exit for
End If
If Len(ActiveCell.Value) = 0 Then
MsgBox "Finished Data Check", vbOKOnly + vbInformation, _
"Reporting"
Exit For
End If
kr = ActiveCell.Value
Next A

If FoundADuplicate = True Then
'just a single message instead of a message
'for each duplicate
MsgBox "There are duplicate trade references." _
& vbLf & "Please discuss with Business Support"
Else
Worksheets("Cleaned Results").Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\New Report" _
& Month(Range("F2").Value) _
& Day(Range("F2").Value) _
& Year(Range("F2").Value) & ".csv"
wb.Close
End If

Exit Sub

Merr:
MsgBox Err.Description

End Sub

But your code only looks for consecutive duplicates, right?


PVANS wrote:

Hi there

Hope someone can help me with this. I currently have the following code
that searches column for duplicate entries and highlights them:

Sub FindDuplicate()
On Error GoTo Merr
Dim kr As String
ColNameIn = "C"
If Len(ColNameIn) = 0 Then Exit Sub
Range(ColNameIn & 1).Activate
For A = 1 To 200
Range(ColNameIn & A).Activate
If ActiveCell.Value = kr Then
ActiveCell.Font.Bold = True
Selection.Interior.ColorIndex = 6
MsgBox "There are duplicate trade references. Please discuss with
Business Support"
Else
End If
If Len(ActiveCell.Value) = 0 Then
MsgBox "Finished Data Check", vbOKOnly + vbInformation, "Reporting"
Exit Sub
End If
kr = ActiveCell.Value
Next A
Exit Sub
Merr:
MsgBox Err.Description
End Sub

It works perfectly. However, what I need to happen, is, if no duplicate
records are found, for the following code to be invoked:
Worksheets("Cleaned Results").Copy
Set wb = ActiveWorkbook
wb.SaveAs "C:\New Report" & Month(Range("F2").Value) &
Day(Range("F2").Value) & Year(Range("F2").Value) & ".csv"
wb.Close

If duplicate records are found, I want the sub to end so that the user can
fix these issues.

Would be so grateful for some help with this.

Thanks

Paul

--

Dave Peterson
.