Hoogste nummer na wijziging

[Ivanhoes]

Hoi mensen,

Ik ben op zoek naar een VBA-code, waarbij een cel de hoogste waarde in een bereik moet krijgen na een wijziging in een andere cel.
Ik denk niet dat het ook met een formule kan.

Zie het bestandje.

Voorbeeld:
In kolom A staan namen
In kBekijk bijlage Oplopende nummering na wijziging vba.xlsmolom B staat een oplopende nummering, indien de naastgelegen waarde in kolom C "Ja" is.
In kolom C staat alleen maar Ja of Nee.

Eerste Voorbeeld:
Zodra C7 wijzigt in "Ja", moet B7 het hoogste nummer krijgen. In dit geval dus 7.
Als daarna C11 wijzigt in "Ja", moet B11 het hoogste nummer krijgen. In dit geval moet dat getal dan 8 worden.
Het getal 7 in B7 moet dus blijven staan na de eerste wijziging.

Welke cel als eerste wijzigt maakt niet uit. De bijbehorende waarde in kolom B moet dan het hoogste nummer krijgen.
Het is dus mogelijk dat eerst cel C11 wijzigt (en B11 dus de waarde 7 krijgt) en daarna pas C7 (en dus B7 de waarde 8 krijgt).

Indien de waarden in kolom C weer terug zouden wijzigen naar "Nee", hoeft er niets te veranderen in de nummering.

Ik hoop dat iemand mij kan helpen.

Alvast bedankt en groetjes,

Ivanhoes.

 

[plongske]

Het kan met een formule; Zie gele cellen

sorry verkeerd begrepen

 

[Ivanhoes]

Hoi Plongske,

Zoals je al schreef: verkeerd begrepen. Toch alvast bedankt voor het meekijken en meedenken!

Groetjes,

ivanhoes.

 

[HSV]

Test het eens.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("c5:c12")) Is Nothing And Target.Count = 1 Then
  If LCase(Target.Value) = "ja" Then
    Target.Offset(, -1).ClearContents
    Target.Offset(, -1) = Application.Max(Range("b5:b12")) + 1
  Else
    Target.Offset(, -1).ClearContents
  End If
 End If
End Sub

 

[MarcelBeug]

Of deze (met dank aan Harry voor de Application.Max).

Edit: ik had begrepen dat er niets leeg gemaakt hoeft te worden.
Nog een edit: .... hetgeen natuurlijk incorrect was. Onderstaande gewijzigde code inclusief leegmaken als de waarde "Nee" is geworden.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column <> 3 Then Exit Sub
    
    If Target.Value = "Ja" Then
        Target.Offset(, -1).Value = 1 + Application.Max(Range(Target.End(xlUp).Offset(, -1), Target.End(xlDown).Offset(, -1)))
    ElseIf Target.Value = "Nee" Then Target.Offset(, -1).ClearContents
    End If
    
End Sub

 

[snb]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.column=3 and Target.Count = 1 Then Target.Offset(, -1) = IIf(LCase(Target) = "ja", Application.Max(Target.CurrentRegion.Columns(2)) + 1, "")
End Sub

 

[MarcelBeug]

Wel leerzaam, zo stap voor stap naar de juiste oplossing.

 

[HSV]

Een juiste oplossing is relatief.
Wat gebeurt er in de code als er onverhoopt weer een 'Ja' gezet wordt waar al een cijfer naast staat.

 

[sylvester-ponte]

deze zet de getalletjes weer terug naar de laagste stand(met behoud van volgorde).

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rij As Integer, C As Range
    Set C = Range("b5:b12")
    Application.EnableEvents = False
    If Not Intersect(Target, C.Offset(, 1)) Is Nothing And Target.Count = 1 Then
        If LCase(Target.Value) = "ja" Then
            Target.Offset(, -1) = Application.Max(C) + 1
        Else
            Target.Offset(, -1).ClearContents
        End If
        For Rij = 1 To C.Rows.Count
            On Error GoTo eind
            C.Find(WorksheetFunction.Small(C, Rij)) = Rij
        Next
    End If
eind:
    Application.EnableEvents = True
End Sub

 

[Ivanhoes]

Hoi mensen,

Bedankt voor de reacties!

Voor zover ik nu, na een aantal kleine testjes kan zien, werken alle codes zoals het gevraagd was.
In VBA-code ben ik nog steeds een beginner, dus ik ben blij met deze oplossingen.

Ik ben iets vertraagd met mijn reactie, omdat ik eerst nog moest werken. Excuus daarvoor.


Groetjes,

Ivanhoes.