1 naam per kolom

[Spekker]

Goedemorgen allemaal

Ik heb een rooster gemaakt en daarin is het de bedoeling dat er per kolom maar 1 keer een naam mag voorkomen
graag wil ik dat wanneer er toch wordt gekozen om de naam voor een tweede maal te gebruiken dat er een meding komt

Ben aan het zoeken geweest hoe ik dat kan doen maar kom daar niet uit

 

[edmoor]

Je bedoelt dus niet dat er maar 1x een naam voor mag komen maar dat een naam maar 1x voor mag komen. Dat zit nogal verschil in.
Vertel er ook bij over welk blad en welke kolom je het hebt.

 

[Spekker]

De bedoeling is dat er in bv kolom C een naam wordt ingevuld dat wordt dan gedaan via de droplist, het is dan de bedoeling dat er in de kolom niet nogmaals de zelfde naam gebruikt kan worden. dus er moet dan een andere naam worden gekozen. Op deze manier kan je nooit een persoon dubbel invoeren

 

[edmoor]

Ik vroeg ook om de naam van het blad, maar dat zal wel Week 1 zijn. Zet dit eens achter dat blad:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Select Case Target.Row
        Case 4 To 39
            Select Case Target.Column
                Case 3 To 10
                    For i = 3 To 6
                        If Target.Row <> i And Cells(i, Target.Column).Value = Target.Value Then
                            If Target.Value <> "????" Then
                                MsgBox Target.Value & " is al ingedeeld.", vbCritical, "Reeds ingedeeld"
                                Application.EnableEvents = False
                                Target.Value = "????"
                                Application.EnableEvents = True
                                Exit Sub
                            End If
                        End If
                    Next i
            End Select
    End Select
End Sub

Deze controleert de regels 4 t/m 39 in de kolommen C t/m J.
Zo mag de naam in meerdere kolommen worden gebruikt maar slechts 1x per kolom.
Tevens is er rekening gehouden met je dubbelklik routine.

 

[pasan]

een andere mogelijkheid

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False

If Not Intersect(Target, Range("C4:j39")) Is Nothing Then

 With Target
  If WorksheetFunction.CountIf(Range(Cells(4, .Column), Cells(39, .Column)), .Value) > 1 Then
    MsgBox "Deze waarde komt al voor in deze kolom"
     Target = "????"
   End If
 End With

End If

Application.EnableEvents = True

End Sub

 

[Spekker]

dank jullie wel voor de info en de hulp

de VBA van edmoor deed niet wat ik precies wilden
die van pasan deed het beter maar daar moet ik dan gaan zoeken hoe ik er voor kan zorgen dat ook de X, ???? en de T er dubbel in voorkomen

 

[edmoor]

Beide doen precies wat je vroeg. Je zal dan beter moeten uitleggen welke controle je wilt.

 

[Spekker]

Bekijk bijlage Kopie van Copy of dAAN b.xlsm

in de file zal je zien dat ik nu niet meer de ???? of de T en de X kan gebruiken in de kolom deze zijn wel nodig om dubbel te gebruiken
sorry dat ik dat niet goed heb gevraagd.

 

[edmoor]

Geeft niks, het is vaak moeilijk om uit te leggen wat precies de bedoeling is
Met wat ik voor je maakte mag die ???? wel dubbel voor komen. De T en X inderdaad niet, maar dat is eenvoudig aan te passen.

 

[Spekker]

Edmoor de ???? en de X en de T mogen juist wel meerdere malen voorkomen in de kolom

ben al een tijdje aan het kijken hoe jullie dat doen

 

[edmoor]

Dat is ook wat ik bedoelde Probeer deze maar eens:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Select Case Target.Row
        Case 4 To 39
            Select Case Target.Column
                Case 3 To 10
                    For i = 3 To 6
                        If Target.Row <> i And Cells(i, Target.Column).Value = Target.Value Then
                            If InStr("????TX", Target.Value) = 0 Then
                                MsgBox Target.Value & " is al ingedeeld.", vbCritical, "Reeds ingedeeld"
                                Application.EnableEvents = False
                                Target.Value = "????"
                                Application.EnableEvents = True
                                Exit Sub
                            End If
                        End If
                    Next i
            End Select
    End Select
End Sub

 

[Spekker]

Edmoor ik kom er achter als je op rij C8 en rij C9 de zelfde naam neer zet je geen melding krijgt, en dat terwijl de code volgens mij wel aangeeft dat het van cel C4 t/m C 39 moet gaan

 

[edmoor]

Er zat inderdaad nog een oude waarde in. Is aangepast in deze:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Select Case Target.Row
        Case 4 To 39
            Select Case Target.Column
                Case 3 To 10
                    For i = 4 To 39
                        If Target.Row <> i And Cells(i, Target.Column).Value = Target.Value Then
                            If InStr("????TX", Trim(Target.Value)) = 0 Then
                                MsgBox Target.Value & " is al ingedeeld.", vbCritical, "Reeds ingedeeld"
                                Application.EnableEvents = False
                                Target.Value = "????"
                                Application.EnableEvents = True
                                Exit Sub
                            End If
                        End If
                    Next i
            End Select
    End Select
End Sub

 

[Spekker]

he dank je wel voor de aanpassing, ik heb hem in mijn file verwerkt en kan er nu weer verder mee
ik ga deze op klaar zetten en zal later nog wel komen voor een vervolg vraag
iedereen die hier aan mee heeft gewerkt Bedankt en een goede jaarwisseling

 

[pasan]

Voor de laatste keer Dit jaar

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("C4:j39")) Is Nothing Then
  With Target
   If Trim(Target) = "????" Or Trim(Target) = "T" Then Exit Sub
    Application.EnableEvents = False
 
     If WorksheetFunction.CountIf(Range(Cells(4, .Column), Cells(39, .Column)), .Value) > 1 Then
       MsgBox "Deze waarde komt al voor in deze kolom"
       Target = ""
     End If
   
    Application.EnableEvents = True
  End With
 End If
End Sub