VBA code voor gegevensvalidatie

[KingJozef]

Ik wil graag een VBA code waarmee
de invoergegevens in een range bijv. A1:A7 worden beperkt.
De beperking is : alleen de volgende namen mogen worden ingevoerd
Peter, Jos, Marcel, Henk
Bovendien mogen deze namen maar 1x in de range voorkomen.
Alvast bedankt voor jullie hulp.

 

[wieter]

Bekijk bijgevoegd voorbeeld eens.
De code is van SNB

 

[ZiGZaG37]

Sub Randomnaam()

Dim cntPeter, cntJos, cntMarcel, cntHenk As Integer
cntPeter = 0
cntJos = 0
cntMarcel = 0
cntHenk = 0

For i = 1 To 7
    If Range("A" & i).Value = "Peter" Then
        cntPeter = cntPeter + 1
    ElseIf Range("A" & i).Value = "Jos" Then
        cntJos = cntJos + 1
    ElseIf Range("A" & i).Value = "Marcel" Then
        cntMarcel = cntMarcel + 1
    ElseIf Range("A" & i).Value = "Henk" Then
        cntHenk = cntHenk + 1
    ElseIf Range("A" & i).Value <> "" Then
        MsgBox ("Ongeldige info in A" & i)
    End If
    
Next i
If cntPeter > 1 Then
    MsgBox ("Teveel Peters")
End If
If cntJos > 1 Then
    MsgBox ("Teveel Jossen")
End If
If cntMarcel > 1 Then
    MsgBox ("Teveel Marcellen")
End If
If cntHenk > 1 Then
    MsgBox ("Teveel Henken")
End If

End Sub

 

[edmoor]

Of deze achter het betreffende werkblad:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A1:A7")) Is Nothing Then
        If InStr(1, "peterjosmarcelhenk", LCase(Target.Value)) > 0 Then
            If WorksheetFunction.CountIf(Range("A1:A7"), Target.Value) > 1 Then
                MsgBox Target & " is al ingevoerd", "Naam"
                Target.Value = ""
                Range(Target.Address).Activate
            End If
        Else
            MsgBox "Ongeldige naam", vbCritical, Target.value
            Range(Target.Address).Activate
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[KingJozef]

Sub Randomnaam()

Dim cntPeter, cntJos, cntMarcel, cntHenk As Integer
cntPeter = 0
cntJos = 0
cntMarcel = 0
cntHenk = 0

For i = 1 To 7
    If Range("A" & i).Value = "Peter" Then
        cntPeter = cntPeter + 1
    ElseIf Range("A" & i).Value = "Jos" Then
        cntJos = cntJos + 1
    ElseIf Range("A" & i).Value = "Marcel" Then
        cntMarcel = cntMarcel + 1
    ElseIf Range("A" & i).Value = "Henk" Then
        cntHenk = cntHenk + 1
    ElseIf Range("A" & i).Value <> "" Then
        MsgBox ("Ongeldige info in A" & i)
    End If
    
Next i
If cntPeter > 1 Then
    MsgBox ("Teveel Peters")
End If
If cntJos > 1 Then
    MsgBox ("Teveel Jossen")
End If
If cntMarcel > 1 Then
    MsgBox ("Teveel Marcellen")
End If
If cntHenk > 1 Then
    MsgBox ("Teveel Henken")
End If

End Sub

Bedankt ZiGZaG37 voor je hulp.
ik kan nu de hele range vullen met één naam en krijg de melding dat er teveel peters of zo zijn ingevuld pas als de macro wordt uitgevoerd.
Ik wil echter dat de invoer blokkeert op het moment als een naam voor de 2de keer wordt ingevuld. Met daarbij de melding van bijv. dubbel invoer niet mogelijk!

 

[KingJozef]

Of deze:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A1:A7")) Is Nothing Then
        If InStr(1, "peterjosmarcelhenk", LCase(Target.Value)) > 0 Then
            If WorksheetFunction.CountIf(Range("A1:A7"), Target.Value) > 1 Then
                MsgBox Target & " is al ingevoerd"
                Target.Value = ""
                Range(Target.Address).Activate
            End If
        Else
            MsgBox "Ongeldige naam", vbCritical, "Naam"
            Range(Target.Address).Activate
        End If
    End If
    Application.EnableEvents = True
End Sub

edmoor bedankt voor je hulp dit is precies wat ik nodig heb.
Ik heb alleen Target.Value = "" nog aangevuld voor als een foute naam wordt gebruikt.
zodat ook dan de cel weer leeg is!
Bedankt.

 

[edmoor]

Daar ben je geheel vrij in uiteraard

 

[emields]

Dit is er eentje zonder vba