|
Check for duplicate values
What VB macro code can be used to check for duplicate values AFTER all
entries are made into a column instead of as they are being entered? I am running Microsoft Visual Basic 6.5 in Office 2002. I found the code below, written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED: '---------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim Found As Range Set rng = Columns(myColumn) If Intersect(Target, rng) Is Nothing Then Exit Sub Set Found = rng.Find(Target.Value) If Found.Address < Target.Address Then MsgBox ("Duplicate code") End Sub '----------------------------------- |
Check for duplicate values
Modified...Try the below and feedback
Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed End If End If Next End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: What VB macro code can be used to check for duplicate values AFTER all entries are made into a column instead of as they are being entered? I am running Microsoft Visual Basic 6.5 in Office 2002. I found the code below, written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED: '---------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim Found As Range Set rng = Columns(myColumn) If Intersect(Target, rng) Is Nothing Then Exit Sub Set Found = rng.Find(Target.Value) If Found.Address < Target.Address Then MsgBox ("Duplicate code") End Sub '----------------------------------- |
Check for duplicate values
It worked very well. Can it be modified to inform the user whether or not
duplicates were found and, if necessary, make corrections then rerun the macro to check for duplicates again? "Jacob Skaria" wrote: Modified...Try the below and feedback Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed End If End If Next End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: What VB macro code can be used to check for duplicate values AFTER all entries are made into a column instead of as they are being entered? I am running Microsoft Visual Basic 6.5 in Office 2002. I found the code below, written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED: '---------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim Found As Range Set rng = Columns(myColumn) If Intersect(Target, rng) Is Nothing Then Exit Sub Set Found = rng.Find(Target.Value) If Found.Address < Target.Address Then MsgBox ("Duplicate code") End Sub '----------------------------------- |
Check for duplicate values
Untested...Try and feedback
Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range Dim blnCount as Boolean lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) rng.Interior.ColorIndex = xlNone For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed:blnFound = True End If End If End If Next If blnFound = True then Msgbox "Duplicates Found" End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: It worked very well. Can it be modified to inform the user whether or not duplicates were found and, if necessary, make corrections then rerun the macro to check for duplicates again? "Jacob Skaria" wrote: Modified...Try the below and feedback Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed End If End If Next End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: What VB macro code can be used to check for duplicate values AFTER all entries are made into a column instead of as they are being entered? I am running Microsoft Visual Basic 6.5 in Office 2002. I found the code below, written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED: '---------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim Found As Range Set rng = Columns(myColumn) If Intersect(Target, rng) Is Nothing Then Exit Sub Set Found = rng.Find(Target.Value) If Found.Address < Target.Address Then MsgBox ("Duplicate code") End Sub '----------------------------------- |
Check for duplicate values
Typo...corrected..
Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range Dim blnFound as Boolean lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) rng.Interior.ColorIndex = xlNone For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed:blnFound = True End If End If End If Next If blnFound = True then Msgbox "Duplicates Found" End Sub -- If this post helps click Yes --------------- Jacob Skaria "Jacob Skaria" wrote: Untested...Try and feedback Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range Dim blnCount as Boolean lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) rng.Interior.ColorIndex = xlNone For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed:blnFound = True End If End If End If Next If blnFound = True then Msgbox "Duplicates Found" End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: It worked very well. Can it be modified to inform the user whether or not duplicates were found and, if necessary, make corrections then rerun the macro to check for duplicates again? "Jacob Skaria" wrote: Modified...Try the below and feedback Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed End If End If Next End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: What VB macro code can be used to check for duplicate values AFTER all entries are made into a column instead of as they are being entered? I am running Microsoft Visual Basic 6.5 in Office 2002. I found the code below, written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED: '---------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim Found As Range Set rng = Columns(myColumn) If Intersect(Target, rng) Is Nothing Then Exit Sub Set Found = rng.Find(Target.Value) If Found.Address < Target.Address Then MsgBox ("Duplicate code") End Sub '----------------------------------- |
Check for duplicate values
Tested successfully. I removed "rng.Interior.ColorIndex = xlNone". Would it
be possible to increase the range from one column to multiple columns? "Jacob Skaria" wrote: Typo...corrected.. Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range Dim blnFound as Boolean lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) rng.Interior.ColorIndex = xlNone For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed:blnFound = True End If End If End If Next If blnFound = True then Msgbox "Duplicates Found" End Sub -- If this post helps click Yes --------------- Jacob Skaria "Jacob Skaria" wrote: Untested...Try and feedback Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range Dim blnCount as Boolean lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) rng.Interior.ColorIndex = xlNone For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed:blnFound = True End If End If End If Next If blnFound = True then Msgbox "Duplicates Found" End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: It worked very well. Can it be modified to inform the user whether or not duplicates were found and, if necessary, make corrections then rerun the macro to check for duplicates again? "Jacob Skaria" wrote: Modified...Try the below and feedback Sub Macro() 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim cell As Range Dim Found As Range lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow) For Each cell In rng If cell.Text < "" And IsError(cell.Value) < True Then Set Found = rng.Find(cell.Value) If Not Found Is Nothing Then If Found.Address < cell.Address Then cell.Interior.Color = vbRed End If End If Next End Sub -- If this post helps click Yes --------------- Jacob Skaria "Freddy" wrote: What VB macro code can be used to check for duplicate values AFTER all entries are made into a column instead of as they are being entered? I am running Microsoft Visual Basic 6.5 in Office 2002. I found the code below, written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED: '---------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) 'Adjust next constant to your own needs Const myColumn As String = "B" Dim rng As Range Dim Found As Range Set rng = Columns(myColumn) If Intersect(Target, rng) Is Nothing Then Exit Sub Set Found = rng.Find(Target.Value) If Found.Address < Target.Address Then MsgBox ("Duplicate code") End Sub '----------------------------------- |
| All times are GMT +1. The time now is 02:28 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com