Automatisch invullen van meerdere cellen na validatie

[VenA]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim f As Range
  If Intersect(Target, Range("I:J")) Is Nothing Or Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  Set f = Sheets("gegevens lijst").Columns(3).Find(Target.Value, , xlValues, xlWhole)
  If Not f Is Nothing Then
    Target.Offset(, IIf(Target.Column = 9, -4, -7)) = f.Offset(, 1).Value
    Target = Trim(Split(Target, "-")(UBound(Split(Target, "-"))))
    If Target.Column = 10 Then Range("A8:J" & Cells(Rows.Count, 8).End(xlUp).Row).Sort Range("H8"), , Range("I8"), , , Range("J8"), , xlNo
  End If
  Application.EnableEvents = True
End Sub

 

[Tjoptjop333]

Opzich werkt dit prima, alleen nu gaat de sorteer functie in de war raken :S... Deze moet wel de getallen gebruiken welke er voor staan.. Het programma haalt keurig de - streepjes weg, maar sorteert vervolgens op de waarde van de letters.. Dit is niet de bedoeling..

 

[VenA]

Dan sorteer je toch op H8, E8, C8?

 

[Tjoptjop333]

Simpel inderdaad... Soms denk je er te veel over na en ligt het antwoord voor de hand..

En als ik er een kolom bij wil hebben om te sorteren? Bv Kolom G?

 

[VenA]

De range.sort methode kan maar op drie kolommen sorteren. Neem een macro op om op meer kolommen te sorteren en pas deze aan naar eigen wensen. Je krijgt dan zoiets

Sub VenA()
  With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add Range("H8")
    .SortFields.Add Range("E8")
    .SortFields.Add Range("C8")
    .SortFields.Add Range("G8")
    .SetRange Range("A8:J" & Cells(Rows.Count, 8).End(xlUp).Row)
    .Header = xlNo
    .Apply
  End With
End Sub

 

[Tjoptjop333]

Prima, dank je wel weer, ga ik morgen weer mee stoeien.

 

[Tjoptjop333]

Goedemorgen VenA,

T.b.v. de aangeleverde code, heb ik deze toegevoegd. Echter hij sorteert niet na het ingeven van de laatste invoering "verdieping". Als toevoeging zou ik graag willen dat na het invoeren van de verdieping en dan de sortering, dat deze regel actief blijft. Nu na het invoeren van de verdieping, wordt er gesorteerd en blijft de regel actief waarop is ingevoerd en dit is niet de laatste. Nu dient er gezocht te worden waar de regel is gebleven en vervolgens de overige gegevens in te voeren... Is dit ook als dusdanig mee te nemen in de code?
Momenteel als code toegepast:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim f As Range
If Intersect(Target, Range("I:J")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Set f = Sheets("gegevens lijst").Columns(3).Find(Target.Value, , xlValues, xlWhole)
If Not f Is Nothing Then
Target.Offset(, IIf(Target.Column = 9, -4, -7)) = f.Offset(, 1).Value
Target = Trim(Split(Target, "-")(UBound(Split(Target, "-"))))
End If
Application.EnableEvents = True
End Sub

Sub VenA()
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Range("H8")
.SortFields.Add Range("E8")
.SortFields.Add Range("C8")
.SortFields.Add Range("G8")
.SetRange Range("A8:J" & Cells(Rows.Count, 8).End(xlUp).Row)
.Header = xlNo
.Apply
End With
End Sub

 

[VenA]

Gebruik svp codetags

Zet de sub VenA onder een knop. Persoonlijk vind ik het niets dat een tabel automatch sorteert.

 

[Tjoptjop333]

Goedemorgen.

Mijn excuus, dit is nog even nieuw voor me en moet even bekijken hoe of dat gaat met de codetags...

 

[Tjoptjop333]

Is inderdaad een veel betere oplossing een knop toevoegen. Gedaan en werkt .

Een andere vraag nog:
Nu dat ik toch met knoppen ook in de weer ga, zou ik graag een knop willen gebruiken die een regel toevoegt na de laatste ingevulde regel, met de volgende invoeging:

In hokje A: het objectnummer (=tekst H2)
In hokje B, D en F: - (Een minstreepje)
Start cel om in te voeren H;

Is dit gemakkelijk te schrijven als code?

 

[VenA]

Best wel. De dubbelklik in #16 doet toch al zoiets?

 

[Tjoptjop333]

Dat klopt wel, echter dan wordt de gehele regel gekopieerd... Ik ben bang dat mn collega's zich hierin gaan vergissen en het een bende wordt :S.

Mooiste zou zijn alleen het objectnummer en de streepjes. En dan dit door middel van een knop, net als het sorteren.. Heb jij hier een code voor?

 

[VenA]

Dan maak je de handel toch leeg?

Sub VenA()
  Rows(8).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
  Cells(Rows.Count, 1).End(xlUp).Resize(, 10) = Array([h2], "-", "", "-", "", "-", "", "", "", "", "")
End Sub

Je kan beter een echte tabel gebruiken dan gaat de validatie vanzelf mee en heb je geen VBA nodig. Als je de streepjes als formule in een tabel zet dan gaan deze ook automatisch mee. (="-")

 

[Tjoptjop333]

Dit is perfect. Dank je wel, denk dat het nu wel helder heb staan. Ben inderdaad overgegaan naar een tabel.

 

[Tjoptjop333]

Vervelende is nu wel, dat er een selectie of sorteerfunctie op elke kolom aanwezig is. Dit is niet geheel noodzakelijk. Kan ik ook filters van kolommen afhalen?

 

[Tjoptjop333]

Beste VenA,

Ik ben inmiddels een heel end verder met de opmaak van de tekeningenlijst, zie bijgaand .
Nu wil ik graag nog 1 ding dat het formulier/Tabel doet en dat is het selectievinkje bij DWG, mee kopieert/tevens verschijnt op de volgende regel als ik een regel toevoeg. Heb jij een oplossing hiervoor?

Bekijk bijlage 303 Tekeningenlijst - TEST.xlsm

 

[Tjoptjop333]

Ik ben inmiddels iets verder en heb een knop gemaakt en de volgende code toegevoegd

Sub Knop10_Klikken()
    Rows("8:8").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.CheckBoxes.Add(1280.25, 104, 24, 17.25).Select
    Target = H8
End Sub

Er wordt een rij toegevoegd met een selectievinkje , echter bij het nogmaals indrukken van de knop, wordt er weer een rij toegevoegd, verschuift het selectievinkje niet naar de volgende regel, maar wordt er een nieuw selectievinkje over de andere heen geplaatst. Dit is net niet de bedoeling :S...

Zou je me in de code iets kunnen helpen zodat dit correct gaat?

Ook wil ik niet dat bij het invoegen het selectievinkje wordt geselecteerd.. Dit gebeurt uiteraard door het .select commando, maar ken geen andere... Het mooiste zou zijn als cel H8 wordt geselecteerd/start punt wordt om in te voeren..
Van het .select heb ik ook inmiddels opgelost

Sub Knop10_Klikken()
    Rows("8:8").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveSheet.CheckBoxes.Add(1280.25, 104, 24, 17.25).Select
    Selection.Characters.Text = ""
    Range("H8").Select
End Sub