How to apply two conditions in a loop?

user_14963549 0
Viewed 80

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
vba excel
1 Answers

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
user_4788840
Related