How to apply two conditions in a loop?

Question

I'm trying to distribute a known number evenly 1 by 1 across a range where the known number is given by "TV Comodin" Row (in color Red), the data set is as follow:

TV Comodín	L	M	SEGMENTO
Second	20	30	CD
First	10	30	AB
Second	80	30	AB
TV Comodín	500	500	COMODIN

The cell has a limit depending on its category given by the column I, "SEGMENTO".
AB category must to be <= 100 and CD category must to be <= 120.

Sub prueba()
    
    Dim f As Range, ws As Worksheet, comodin As Long, rng As Range, m
    
    Set ws = ActiveSheet

    Set rng = ws.Range("A2", ws.Range("A2").End(xlDown)).Offset(0, 1)
    
    Set f = ws.Columns("A").Find(What:="TV Comodín", LookIn:=xlFormulas, _
                                 LookAt:=xlWhole, MatchCase:=False)
                                 
    lastRow = Range("I" & Rows.Count).End(xlUp).Row

    For i = i + 1 To lastRow
        If Range("I" & i) = "AB" Then
            If Not f Is Nothing Then
                rng.Value = ws.Evaluate("=" & rng.Address() & "*1") 'fill empty cells with zeros
                comodin = f.Offset(0, 1).Value
                Do While comodin > 0
                    mn = Application.Min(rng)
                    If mn >= 100 Then Exit Do    ' exit when no values are <100
                    m = Application.Match(mn, rng, 0)
                    rng.Cells(m).Value = rng.Cells(m).Value + 1
                    comodin = comodin - 1
                    f.Offset(0, 1).Value = comodin
                Loop
            Else
                MsgBox "No found"
            End If
        End If
    Next i
End Sub

It works with the first condition (AB <= 100).

I tried to add the other condition (CD <= 120) by using Elseif inside the loop.

Desired output

TV Comodín	L	M	SEGMENTO
Second	120	30	CD
First	100	30	AB
Second	100	30	AB
TV Comodín	200	500	COMODIN

Answer 1

This worked for me. Basically because you have multiple rules for max value, you need to exclude cells which have already met their maximum value while you process the remaining cells.

When you're done you can "unexclude" the cells.

Sub prueba()
   
    Dim f As Range, ws As Worksheet, comodin As Long, rng As Range, m, mn
    Dim numExcluded As Long, c As Range
    Set ws = ActiveSheet

    Set rng = ws.Range("A2", ws.Range("A2").End(xlDown)).Offset(0, 1)
    
    Set f = ws.Columns("A").Find(What:="TV Comodín", LookIn:=xlFormulas, _
                                 LookAt:=xlWhole, MatchCase:=False)
                                 
    If Not f Is Nothing Then
        
        rng.Value = ws.Evaluate("=" & rng.Address() & "*1") 'fill empty cells with zeros
        comodin = f.Offset(0, 1).Value
        'Loop while we still have additions to make and
        '  all cells have not been excluded
        Do While comodin > 0 And numExcluded < rng.Count
            mn = Application.Min(rng)
            m = Application.Match(mn, rng, 0)
            Set c = rng.Cells(m) 'get the matched cell
            
            If mn < GetMax(c.Offset(0, 2)) Then 'my SEGMENTO are in ColD
                c.Value = c.Value + 1
                comodin = comodin - 1
            Else
                'This cell already at max value: exclude for now...
                c.Value = "x" & c.Value
                numExcluded = numExcluded + 1
            End If
        Loop
        f.Offset(0, 1).Value = comodin
        
        ' "unexclude" any excluded cells
        For Each c In rng.Cells
            If c.Value Like "x*" Then c.Value = Right(c.Value, Len(c.Value) - 1)
        Next c
    Else
        MsgBox "No found"
    End If
End Sub

Function GetMax(v)
    Select Case v
        Case "AB": GetMax = 100
        Case "CD": GetMax = 120
        Case Else: GetMax = 200
    End Select
End Function