dubbele nrs verwijderen in kolom met lijst.

[Damani]

Beste,

ik ben net nieuw op dit forum. ik heb al wat rond gezocht maar zie mijn specifieke vraag niet direct staan.

Bekijk bijlage Workbook1.xlsx

Deze kolom heb ik gemaakt met Validate - Data Validation en dan List gekozen en gerefereerd naar een andere sheet waar alle nummers staan zodat ik telkens uit de lijst met nummers kan kiezen.
Wat ik nu graag zou hebben is wanneer ik bv op het leeg vak sta en een nummer kies uit de lijst dat al in de kolom voorkomt, dat de nummer die al in de kolom staat verwijderd word en die nieuwe blijft zodat ik geen dubbele in de lijst krijg.
Is dit enigszins mogelijk? Zo ja, hoe? Als dit met huidige werkwijze (lijst van data validation) niet het geval is, is er dan een andere mogelijkheid om dit allemaal voor elkaar te krijgen?

Alvast hartelijk bedankt voor jullie antwoord/oplossing en vooral voor de moeite!!

Mvg
Damani

 

[edmoor]

Hoi! En welkom op die forum.
In plaats van een paar plaatjes kun je veel beter een voorbeeld document plaatsen.

 

[Damani]

Hoi! En welkom op die forum.
In plaats van een paar plaatjes kun je veel beter een voorbeeld document plaatsen.

Oke, staat erbij

 

[HSV]

Met een stukje Vba code als je vanaf onderen steeds getallen toevoegd.
Ik ben er vanuit gegaan dat het om tabblad "nrs" gaat.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
 If Not Intersect(Target, Columns(1)) Is Nothing Then
   Set c = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row - 1).Find(Target.Value, , xlValues, xlWhole)
   If Not c Is Nothing Then c.Value = "-"
 End If
Application.EnableEvents = True
End Sub

 

[Damani]

Met een stukje Vba code als je vanaf onderen steeds getallen toevoegd.
Ik ben er vanuit gegaan dat het om tabblad "nrs" gaat.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
 If Not Intersect(Target, Columns(1)) Is Nothing Then
   Set c = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row - 1).Find(Target.Value, , xlValues, xlWhole)
   If Not c Is Nothing Then c.Value = "-"
 End If
Application.EnableEvents = True
End Sub

Het gaat inderdaad over het tabblad nrs.

Wauw!! Dit is bijna wat ik wil maar het zou ook naar boven moeten kunnen.
Er zijn maar 33 nrs in gebruik en zou die 89.. nrs regelmatig van plaats moeten wisselen. door de haast wordt de nummer op de originele plaats soms vergeten waardoor er 2 dezelfde nummers in de kolom staan. dit zou ik dus willen voorkomen. Vandaag kan het zijn dat 8922 op rij 10 komt te staan, morgen staat die misschien op rij 20 en overmorgen terug op rij 1.
hopelijk snap je het.

 

[HSV]

Aub. niet quoten zonder tussenkomst van derden.
Neemt teveel onnodig ruimte in beslag.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
 If Not Intersect(Target, Columns(1)) Is Nothing Then
   Set c = Columns(1).Find(Target.Value, Target, xlValues, xlWhole)
   If Not c Is Nothing Then c.Value = "-"
 End If
Application.EnableEvents = True
End Sub

 

[Damani]

Oke, snap ik van dat quoten.

Dit lukt al aardig, nog enkel 1 probleem. Als een getal niet meer in het kolom voorkomt kan ik het ook niet meer selecteren.

vb ik heb rij 10 8901 veranderd naar 8916. Nu kan ik 8901 niet meer kiezen.

 

[HSV]

Dan moet het zo gaan lukken volgens mij.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
If Target.Count = 1 Then
 If Not Intersect(Target, Columns(1)) Is Nothing Then
   Set c = Columns(1).Find(Target.Value, Target, xlValues, xlWhole)
   If Not c Is Nothing And Target.Address <> c.Address Then
     c.Value = "-"
      End If
    End If
   End If
Application.EnableEvents = True
End Sub

 

[Damani]

Super! Dit is het helemaal.
Nog een ander vraagje dan. Hoe pas ik deze macro toe in het origineel bestand?
En werkt dit op meerdere kolommen/sheets en bv ook andere invoer zoals namen?
Ik heb op tab developer gedrukt en dan macro's maar snap het niet echt.

Al toch super bedankt voor al je moeite tot hiertoe!!

 

[HSV]

Dan graag het juiste bestand toevoegen.

 

[Damani]

Deze bevat ook nummerplaten. Dat zou ik niet graag op internet zetten.
Kan ik het misschien mailen naar u?

 

[HSV]

Helaas, ook naar andere helpers toe blijft het voor mij alleen forum.
Maak een fictief bestandje.

 

[Damani]

Bekijk bijlage Toeren fictief.xlsx

Kolom B,D EN F zouden deze functie moeten hebben.
In sheet MA-DO en VRIJ.
Die 2 had ik ook graag samen gevoegd maar had ooit eens een formule =IF(O1=7;TODAY()+3;TODAY()+1)
maar weet helemaal niet meer hoe ik dat gevonden had en het werkt ook niet meer aangezien er niets in O1 staat. in O1 stond ook =WEEKDAY(N1) maar dat is ook leeg. Dat zal met der tijd verloren gegaan zijn.

 

[HSV]

Druk Alt+F11, en dubbelklik aan de linkerzijde op 'ThisWorkBook'.
Zet in het grote witte vlak onderstaande code.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
If Sh.Name = "MA-DO" Or Sh.Name = "VRIJ" Then
Application.EnableEvents = False
If Target.Count = 1 Then
 If Not Intersect(Target, Union(Columns(2), Columns(4), Columns(6))) Is Nothing Then
   Set c = Columns(Target.Column).Find(Target.Value, Target, xlValues, xlWhole)
   If Not c Is Nothing And Target.Address <> c.Address Then
     c.Value = "-"
      End If
    End If
   End If
Application.EnableEvents = True
End If
End Sub

 

[Damani]

Het werkt helemaal (Nog een klein detail. Telkens ik een nr verander word heel de kolom geselecteerd, is er misschien een mogelijk om dit te voorkomen? is niet noodzakelijk hoor maar dan is het helemaal perfect.)

Super bedankt!!!

 

[HSV]

Vreemd, bij mij niet.

 

[Damani]

Geen probleem. Het werkt, dat is het belangrijkste.
Nogmaals bedankt!!!