Preventing Duplicates In Data Entry vba in all cells

[Luthius]

Hey Guys, I need a function that do a loop through all cells in worksheet based in criteria, not allowing data entry of duplicates values. The criteria I'll put in function for example:

Public Function NoToDuplicate(column as interger)
'The loop
...
Msgbox ("This is a duplicate value")
...
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Call NoToDuplicate(1)
End Sub

For Example:
Everytime when I'll put some value in column (myCriteria - for example "A" column), the function will check if there's the same value in all cells of the column (myCriteria - for example "A" column) of all sheets of my workbook.
All 'A Columns' of all sheets from the same workbook will be checked and if there's duplicate value a msgbox ("This is a duplicate value")

Luthius

 

[gverde]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim oneSheet As Worksheet
    Dim oneCell As Range, keyColumn As Range
    Dim cummulativeCount As Long
 
    Set keyColumn = Sh.Range("A:A").EntireColumn: Rem adjust
 
    If Not (Application.Intersect(Target, keyColumn) Is Nothing) Then
        For Each oneCell In Application.Intersect(Target, keyColumn)
            cummulativeCount = 0
 
            For Each oneSheet In ThisWorkbook.Sheets
                cummulativeCount = cummulativeCount + Application.CountIf(oneSheet.Range(keyColumn.Address), oneCell.Value)
                If cummulativeCount Then
                    With oneSheet.Range(keyColumn)
                        MsgBox oneCell.Address(,,,True) & " duplicates " & _
                            .Find(what:=CStr(oneCell.Value), after:=.Cells(1,1)).Address(,,,True)
                    End With
                End If
            Next oneSheet
 
        Next oneCell
    End If
End Sub

hey mike, i getting a
method 'range' of object '_worksheet' failed


after hitting debug its highlighting this row...

With oneSheet.Range(keyColumn)
​

 

[Nalani]

I was going to post the exact Error problem when I saw gverde's post

I think Mike's new code was addressing my post #18 above.

He may not have worked on your post yet, gverde, because currently there is no mention of "color" in the code.

Maybe a little more explanation to your requirment might help him.

 

[mikerickson]

oops

With oneSheet.Range(keyColumn.Address)

 

[Nalani]

Thanks Mike, getting there.

It is producing 2 Msg Boxes. One saying that the duplicate is on the sheet that I just entered it on and one on the sheet that it resides on.

Sheet2

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Calibri,Arial; FONT-SIZE: 11pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 64px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>A</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD>you</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD>me</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD>them</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD>us</TD></TR></TBODY></TABLE>

Excel tables to the web >> http://www.excel-jeanie-html.de/index.php?f=1" target="_blank"> Excel Jeanie HTML 4


Sheet1

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Calibri,Arial; FONT-SIZE: 11pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 64px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>A</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD>me</TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD> </TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD> </TD></TR><TR style="HEIGHT: 22px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD> </TD></TR></TBODY></TABLE>

Excel tables to the web >> http://www.excel-jeanie-html.de/index.php?f=1" target="_blank"> Excel Jeanie HTML 4


The above is my Sample sheets. When I type "me" in Sheet1 A1 I get the 2 MsgBoxes.

 

[mikerickson]

            For Each oneSheet In ThisWorkbook.Sheets
              [COLOR="Red"]If oneSheet.Name <> sh.Name Then[/COLOR]
                cummulativeCount = cummulativeCount + Application.CountIf(oneSheet.Range(keyColumn.Address), oneCell.Value)
                If cummulativeCount Then
                    With oneSheet.Range(keyColumn)
                        MsgBox oneCell.Address(,,,True) & " duplicates " & _
                            .Find(what:=CStr(oneCell.Value), after:=.Cells(1,1)).Address(,,,True)
                    End With
                End If
              [COLOR="red"]End If[/COLOR]
            Next oneSheet

 

[Nalani]

Thank you Mike

Works great

 

[gverde]

Hey Mike,
ive been trying this for a while now...

i want to change the target cells to red. with no pop ups. any suggestions???