Finding duplicate values
-
- 3StarLounger
- Posts: 200
- Joined: 24 Aug 2011, 13:13
Re: Finding duplicate values
But there is no last row specified....
-
- Administrator
- Posts: 78631
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Finding duplicate values
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
to
Code: Select all
LastRow = Cells(Rows.Count, DateCol).End(xlUp).Row
Code: Select all
LastRow = 381
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 200
- Joined: 24 Aug 2011, 13:13
Re: Finding duplicate values
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
-
- Administrator
- Posts: 78631
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Finding duplicate values
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
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 200
- Joined: 24 Aug 2011, 13:13
Re: Finding duplicate values
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.
-
- Administrator
- Posts: 78631
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Finding duplicate values
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
Best wishes,
Hans
Hans