Controleren op range of de cellen unique zijn.

[mause01]

Heren,

Ik heb de volgende code geschreven om range C7:C5000 te controleren op
Waarde ""
AlphaNumeric
Lengte

Nu wil ik ook een IF maken met het controleren op de waarde of deze unique is.
Welke If moet ik gebruiken.

'ExtID
    Set rng = Range("C7:C5000")
    If Not Application.Intersect(Target, rng) Is Nothing Then
        For Each aCell In rng
            If aCell.Value <> "" Then
                If Len(aCell.Value) < 33 Then
                    If AlphaNumeric(aCell.Value) = True Then
                    
                    Else
                        aCell.Interior.ColorIndex = 3
                        MsgBox "Incorrect date in cell " & aCell.Address
                    End If
                Else
                    aCell.ClearContents
                    MsgBox "Incorrect date in cell " & aCell.Address
                End If
            End If
        Next
    End If

 

[E v R]

waarom het hele bereik controleren en niet enkel de Target?
Je zou dan kunnen controleren of jouw Target.value middels countif meer dan 1 keer voorkomt in rng

 

[Ginger]

Mijn voorstel zou zelfs zijn dat je moet voorkomen dat een gebruiker foute gegevens plaatst. Dit kan je zelfs met Data Validatie afvangen en is geen VBA voor "naderhand" nodig...

 

[gast0660]

Option Explicit
Dim fCell As Variant
Dim msg As String
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    If Target.Cells.CountLarge > 1 Then Exit Sub
    fCell = WorksheetFunction.CountIf(Me.Range("C:C"), Target.Value)
    If fCell > 1 Then msg = "Waarde " & Target.Value & " bestaat al." & Chr(10)
    If msg <> "" Then MsgBox msg
    End Sub

 

[mause01]

Bedankt voor de Code,

ik heb hem werkend maar enkel wanneer ik een dubbele waarde in geef.
verwijderd deze een voor een alle waardes.
Ik wil graag C7:C5000 controleren op unique waardes en wanneer er 2 keer dezefde waarde voorkomt moet deze verwijderd worden en een bericht geven.
wat gaat er mis?

'ExtID                                                                  !!!!!!!!!!!!!!!! CHECK NEEDED !!!!!!!!!!!!!!!
    Set rng = Range("C7:C5000")
    If Not Application.Intersect(Target, rng) Is Nothing Then
        For Each aCell In rng
            If aCell.Value <> "" Then
                If Len(aCell.Value) < 41 Then
                    If AlphaNumeric(aCell.Value) = True Then
                            'Dim fCell As Variant
                            'Dim msg As String
                        If Intersect(Target, rng) Is Nothing Then
                        Else
                            'aCell.ClearContents
                            'MsgBox "Incorrect date in cell " & aCell.Address
                        End If
                        If Target.Cells.CountLarge > 1 Then
                        Else
                            'aCell.ClearContents
                            'MsgBox "Incorrect date in cell " & aCell.Address
                        End If
                        fCell = WorksheetFunction.CountIf(rng, Target.Value)
                        If fCell > 1 Then msg = "Value " & Target.Value & " already exist." & Chr(10)
                        If msg <> "" Then
                            MsgBox msg
                            aCell.ClearContents
                        End If
                      Else
                        aCell.ClearContents
                        MsgBox "Incorrect date in cell " & aCell.Address
                    End If
                Else
                    aCell.ClearContents
                    MsgBox "Incorrect date in cell " & aCell.Address
                End If
            End If
        Next
     End If

Bekijk bijlage Sync_Salto_V2.0.6 MvO.rar