Rijnummers secties op basis van een jaartal

[Esducsafe]

@Helpers
Wanneer in kolom B een jaartal wordt ingevuld wordt kolom A automatisch (op)genummerd tot zover loopt het goed.
Nu wil ik als een ander jaartal wordt ingevuld dat de nummering opnieuw begint.
Wie kan mij helpen met een oplossing?
Meerdere uren zoeken op internet was tot nu toe zonder resultaat.
Alvast bedankt.
Groet,
Esko

Sub NumberRows()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Range("A6:A" & LastRow) = Evaluate("ROW(A1:A" & LastRow & ")")
End Sub

 

[HSV]

Zo bedoel je?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
If Target.Column = 2 And Target.Row > 5 Then
  Application.EnableEvents = False
     LastRow = Cells(Rows.Count, "B").End(xlUp).Row - 1
     Range(Cells(Rows.Count, 1).End(xlUp), Cells(LastRow, 1)) = Evaluate("ROW(A1:A" & LastRow & ")")
     Target.Offset(, -1) = 1
  Application.EnableEvents = True
End If
End Sub

 

[snb]

had Excel daarvoor niet countif uitgevonden ?

in A10

=countif($B$1:$B10,$B10)

 

[Esducsafe]

Beste Harry en SNB,
Bijdrage Harry getest, maar dat werkte helaas niet.
Countif suggestie van SNB is OK, maar de ranges zijn variabel.

Vervolg
Met Fillranges wordt nu in kolom B op basis van een letter de cellen gemarkeerd met een kleur en in kolom A een cijfer ingevuld.
De volgende stap was het hernummeren van de de cijfers in kolom A.
Zie bijlage voor wat ik tot nog toe heb uitgewerkt.
Helaas (nog) geen oplossing gevonden.
Wie kan mij helpen?]
Alvast bedankt,
Groet,
Esko

Bekijk bijlage Rijnummers secties op basis van een jaartal 02.xls

 

[HSV]

Maak eens een bestand met hoe het er uit moet zien i.p.v. een bestand wat niet werkt.

Of bedoel je dit?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Row > 5 Then
  Application.EnableEvents = False
    Range("a6", Cells(Rows.Count, 2).End(xlUp).Offset(, -1)) = "=countif($b$6:b6,b6)"
  Application.EnableEvents = True
End If
End Sub

 

[WoutMag]

Voor blad1 met de jaar kolom kan je deze code proberen:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim YearColumn As Range
    
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    Set YearColumn = Intersect(Target, Range("B:B"))
    
    If YearColumn Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    With Target
        If .Value = .Offset(-1, 0) Then
            .Offset(0, -1).Value = .Offset(-1, -1).Value + 1
        Else
            .Offset(0, -1).Value = 1
        End If
    End With
    Application.EnableEvents = True
    
End Sub

Succes,

 

[Esducsafe]

Harry en Wouter,
Beide bijdragen werken.
Hartelijk dank voor jullie hulp.:thumb:
Groet,
Esko

Op verzoek Harry nog een bestandje bijgevoegd.

Bekijk bijlage Rijnummers secties op basis van een jaartal 03.xls

 

[Esducsafe]

Soms zijn oplossingen zo simpel.

Met VBA was toch geen goed idee!

Nu gebruik gemaakt van Excel funtie "Aantal Als" (Countif)

Dat was ook wat SNB voorstelde.
Hij had dus gelijk.

=ALS(B7="";"";AANTAL.ALS($B$7:B7;B7))

 

[HSV]

Het kan nog simpeler.

 

[Esducsafe]

Harry,
Dank je wel.
Esko