Automatisch sorteren van verschillende celbereiken

[Schant]

Hallo, kan iemand mij helpen?

In bijgevoegde bestand heb ik onderstaande macro geplaatst die ervoor zorgt dat bij invulling van gegevens in kolom I (I3 tot I30) het celbereik van A2 tot T30 wordt gesorteerd op kolom J.
Nu wil ik er daarnaast voor zorgen dat als er gegevens in kolom I (I33 tot I41) worden ingevuld het celbereik van A33 tot T41 wordt gesorteerd op kolom J.
Weet iemand hoe ik dat in één macro kan doen?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("i3:i30")) Is Nothing Then Exit Sub
Range("A2:t30").Select
Selection.Sort _
Key1:=Range("j2"), Order1:=xlDescending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("j3").End(xlUp).Offset(1, 0).Select
End Sub

 

[Roncancio]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lBegin As Long
Dim lEind As Long
    
    lBegin = Range("B" & Target.Row).End(xlUp).Row
    lEind = Range("B" & Target.Row).End(xlDown).Row
    
    Range("A" & lBegin & ":T" & lEind).Sort Key1:=Range("J" & lBegin), Order1:=xlDescending, _
    Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub

Met vriendelijke groet,


Roncancio

 

[Schant]

Geweldig het werkt. Heel erg bedankt.

Het is alleen jammer dat ik niet begrijp hoe het werkt.

 

[Roncancio]

Geweldig het werkt. Heel erg bedankt.

Het is alleen jammer dat ik niet begrijp hoe het werkt.

Graag gedaan.
Het is makkelijker dan je denkt.

Zodra er een wijziging plaatsvindt op het werkblad, zoekt de code in de B-kolom naar de bovenste en onderste rij in het bereik.
Je kunt dit zelf handmatig doen:
- Selecteer een cel in de B-kolom en klik op CTRL-Pijltjestoets omhoog. De cel gaat naar de eerste cel in het bereik.
- Selecteer een cel in de B-kolom en klik op CTRL-Pijltjestoets omlaag. De cel gaat naar de laatste cel in het bereik.

Dit bereik wordt gebruikt om te bepalen welke rijen gesorteerd moeten worden.

Met vriendelijke groet,


Roncancio

 

[Schant]

Hoe wordt in deze code het bereik bepaald dan?

 

[Roncancio]

Hoe wordt in deze code het bereik bepaald dan?

Door de waardes in de B-kolom.
Stel dat er in cel I17 iets wordt aangepast.
Dan zoekt de code op dezelfde regel in de B-kolom de bovenste regel van het bereik. (B3)
Vervolgens wordt de laatste regel van het bereik gevonden (B31)
Dat bereik t/m de T-kolom wordt vervolgens gesorteerd.

Met vriendelijke groet,


Roncancio

 

[Schant]

Door de waardes in de B-kolom.
Stel dat er in cel I17 iets wordt aangepast.
Dan zoekt de code op dezelfde regel in de B-kolom de bovenste regel van het bereik. (B3)
Vervolgens wordt de laatste regel van het bereik gevonden (B31)
Dat bereik t/m de T-kolom wordt vervolgens gesorteerd.

Geweldig, hoe verzin je zoiets?

Het gaat alleen fout als je de waarde in I32 of I43 of I60 verwijderd. Dan vindt de code niet de juiste eerste cel in het bereik en gooit ie alles overhoop.

 

[Roncancio]

Het gaat alleen fout als je de waarde in I32 of I43 of I60 verwijderd. Dan vindt de code niet de juiste eerste cel in het bereik en gooit ie alles overhoop.

Klopt, maar ook dat is te ondervangen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lBegin As Long
Dim lEind As Long

    If Range("B" & Target.Row).Value <> "" Then
        lBegin = Range("B" & Target.Row).End(xlUp).Row
        lEind = Range("B" & Target.Row).End(xlDown).Row

        Range("A" & lBegin & ":T" & lEind).Sort Key1:=Range("J" & lBegin), Order1:=xlDescending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End If
End Sub

De code controleert of er in de B-kolom iets is ingevuld.

Met vriendelijke groet,


Roncancio

 

[HSV]

Ik had deze onderstaande in gedachten.
Maar toen Roncancio met die mooie code kwam, ben ik afgehaakt.
Probeer het eens.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("I3:I30")) Is Nothing Then
    Range("A2:T30").Sort [J2], xlDescending
  End If
 If Not Intersect(Target, Range("I33:I41")) Is Nothing Then
   Range("A33:T41").Sort [J32], xlDescending
  End If
End Sub

Uiteraard wachtende op de verbeterde versie van Roncancio.

Edit: Zelfde tijdstip dus.

 

[Roncancio]

Ik had deze onderstaande in gedachten.
Maar toen Roncancio met die mooie code kwam, ben ik afgehaakt.
Probeer het eens.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("I3:I30")) Is Nothing Then
    Range("A2:T30").Sort [J2], xlDescending
  End If
 If Not Intersect(Target, Range("I33:I41")) Is Nothing Then
   Range("A33:T41").Sort [J32], xlDescending
  End If
End Sub

Uiteraard wachtende op de verbeterde versie van Roncancio.

Edit: Zelfde tijdstip dus.

Bedankt voor de compliment!
Geen reden om af te haken!
Maar je zit lang genoeg op Helpmij om te weten dat als een TS een vraag stelt voor 1 of 2 bereiken en er zijn meerdere soortgelijke bereiken, dat dan al gauw gevraagd wordt om de code ook voor deze bereiken in orde te maken.
Dus probeerde ik 2 vliegen in 1 klap te doen door alvast code te schrijven die bij alle bereiken werken.

Met vriendelijke groet,


Roncancio

 

[Schant]

Heerlijk, die aandacht van twee super programmeurs.:thumb:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lBegin As Long
Dim lEind As Long

If Range("B" & Target.Row).Value <> "" Then
lBegin = Range("B" & Target.Row).End(xlUp).Row
lEind = Range("B" & Target.Row).End(xlDown).Row

Range("A" & lBegin & ":T" & lEind).Sort Key1:=Range("J" & lBegin), Order1:=xlDescending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

Helaas Roncancio, bovenstaande code doesn't do the tric.

De code van HSV lijkt wel te werken, maar moet ik nog uitbreiden met extra cellenbereiken.

 

[HSV]

Bedankt voor de compliment!
Geen reden om af te haken!
Maar je zit lang genoeg op Helpmij om te weten dat als een TS een vraag stelt voor 1 of 2 bereiken en er zijn meerdere soortgelijke bereiken, dat dan al gauw gevraagd wordt om de code ook voor deze bereiken in orde te maken.
Dus probeerde ik 2 vliegen in 1 klap te doen door alvast code te schrijven die bij alle bereiken werken.

Met vriendelijke groet,


Roncancio

Klopt, zo gaat het vaak.
Ik kom net om de hoek kijken met VBA, vandaar dus mijn afhaking.
Maar goed, ik doe er veel mee op door af te kijken en te proberen.

 

[Roncancio]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lBegin As Long
Dim lEind As Long

    If Range("B" & Target.Row - 1).Value = "" Then
        lBegin = Range("B" & Target.Row).Row
        lEind = Range("B" & Target.Row).End(xlDown).Row
    ElseIf Range("B" & Target.Row + 1).Value = "" Then
        lBegin = Range("B" & Target.Row).End(xlUp).Row
        lEind = Range("B" & Target.Row).Row
    ElseIf Range("B" & Target.Row).Value <> "" Then
        lBegin = Range("B" & Target.Row).End(xlUp).Row
        lEind = Range("B" & Target.Row).End(xlDown).Row
    End If
    
    If lEind < ActiveSheet.UsedRange.Rows.Count Then
        Range("A" & lBegin & ":T" & lEind).Sort Key1:=Range("J" & lBegin), Order1:=xlDescending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End If


End Sub

Bovenstaande klopt beter.

Met vriendelijke groet,


Roncancio

 

[Schant]

SUPERRRRR

Nu heb ik twee hele mooie werkende codes. Weten jullie een goede site om de basics van VBA te leren?

 

[HSV]

SUPERRRRR

Nu heb ik twee hele mooie werkende codes. Weten jullie een goede site om de basics van VBA te leren?

Deze vraag laat ik liever aan Roncancio.

 

[Roncancio]

Deze vraag laat ik liever aan Roncancio.

Eerlijk gezegd niet echt.
Op internet zijn legio voorbeelden te vinden. Soms goed, soms "wat minder goed".
Zoek bijvoorbeeld naar Excel VBA Tutorial

Excel VBA
Het is wel handig als je de Engelse taal machtig bent.

Het is vooral een kwestie van try-and-error.

Met vriendelijke groet,


Roncancio