Finding duplicate values

[dmcnab]

But there is no last row specified....

[HansV]

The last row is determined by looking at the last used row in the column with dates (column C in the sample workbook). But if you prefer, you can change the line

Code: Select all

    LastRow = Cells(Rows.Count, DateCol).End(xlUp).Row

to

Code: Select all

    LastRow = 381

[dmcnab]

Good morning, Hans.....I have inserted the most recent code into the workbook....so far it is running very smoothly..and much more quickly than yesterday...the w/sheet where it runs is password protected....where in the sequence of your code would I insert the code that I have for unprotecting (and re-protecting when done) the w/sheet..??..??......at the moment, the interruption occurs at this point in the code: Range(Cells(FirstRow, NoteCol), Cells(LastRow, NoteCol)).ClearContents

[HansV]

Yes, if the sheet is protected, you'd have to unprotect it at the beginning, below the declarations, and protect it again just before the end:

Code: Select all

Sub FindDups()
    Const FirstRow = 3
    Const DateCol = 3 ' C
    Const FirstCol = 4 ' D
    Const LastCol = 13 ' M
    Const NoteCol = 14 ' N
    Dim LastRow As Long
    Dim CurRow As Long
    Dim CurCol As Long
    Dim NxtCol As Long
    Dim CurVal As String
    Dim NxtVal As String
    ' Unrotect the sheet
    ActiveSheet.Unprotect Password:="mysecretpassword"
    ...
    ...
    ' Protect the sheet
    ActiveSheet.Protect Password:="mysecretpassword"
End Sub

[dmcnab]

Good evening, Hans.....the code you gave me is working very smoothly...no hiccups at al.....if I want to exclude some other expressions (aside from "Closed"), where and how can I insert the code? For example, I want to exclude 'Conference' (as well as Conference(am) and Conference(pm))...I tried to insert a comma and the word Conference after the <>"closed" but it didn't work....I have several 'expressions', and the variables of 'expression(am)' and 'expression(pm)' that I want to exclude...can you tell me where to insert the code? Thanks.

[HansV]

Try this version. You can modify the list of exceptions as needed.

Code: Select all

Sub FindDups()
    Const FirstRow = 3
    Const DateCol = 3 ' C
    Const FirstCol = 4 ' D
    Const LastCol = 13 ' M
    Const NoteCol = 14 ' N
    Dim LastRow As Long
    Dim CurRow As Long
    Dim CurCol As Long
    Dim NxtCol As Long
    Dim CurVal As String
    Dim NxtVal As String
    ' Prevent Worksheet_Change event from running
    Application.EnableEvents = False
    ' Unprotect the sheet
    ActiveSheet.Unprotect Password:="mysecretpassword"
    ' Get the last used row
    LastRow = Cells(Rows.Count, DateCol).End(xlUp).Row
    ' Alternatively, specify the last row explicitly
    'LastRow = 381
    ' Reset Bold
    Range(Cells(FirstRow, FirstCol), Cells(LastRow, LastCol)).Font.Bold = False
    ' Clear 1s
    Range(Cells(FirstRow, NoteCol), Cells(LastRow, NoteCol)).ClearContents
    ' Loop
    For CurRow = FirstRow To LastRow
        For CurCol = FirstCol To LastCol - 1
            ' Get cell value and strip it
            CurVal = Replace(Cells(CurRow, CurCol).Value, "?", "")
            CurVal = Replace(CurVal, "^", "")
            CurVal = LCase(Replace(CurVal, "*", ""))
            Select Case CurVal
            ' List exceptions here (all in lower case)
            Case "", "closed", "conference", "conference (am)", "conference (pm)"
                ' Skip these
            Case Else
                ' Loop through cells to the right
                For NxtCol = CurCol + 1 To LastCol
                    ' Get value and strip it
                    NxtVal = Replace(Cells(CurRow, NxtCol).Value, "?", "")
                    NxtVal = Replace(NxtVal, "^", "")
                    NxtVal = LCase(Replace(NxtVal, "*", ""))
                    ' Compare values
                    If CurVal = NxtVal Or _
                            CurVal = Replace(NxtVal, " - a.m.", "") Or _
                            CurVal = Replace(NxtVal, " - p.m.", "") Or _
                            NxtVal = Replace(CurVal, " - a.m.", "") Or _
                            NxtVal = Replace(CurVal, " - p.m.", "") Then
                        ' We have a duplicate - make cells bold
                        Cells(CurRow, CurCol).Font.Bold = True
                        Cells(CurRow, NxtCol).Font.Bold = True
                        ' And enter a 1 in the appropriate column
                        Cells(CurRow, NoteCol).Value = 1
                    End If
                Next NxtCol
            End Select
        Next CurCol
    Next CurRow
    ' Protect the sheet
    ActiveSheet.Protect Password:="mysecretpassword"
    ' Enable Worksheet_Change again
    Application.EnableEvents = True
End Sub