0

I've a problem here, I've been trying to use VBA to distribute a known number evenly across a range.The problem is that I need to find the way where the numbers in the range be as equal as possible to each other, could you help me? or give ideas?

The data set is as follow

enter image description here

The known number is given by "TV Comodin" Row in color Red, and here is my try:

    Sub Prueba()

  Columns("A:A").Select
    Set Cell = Selection.Find(What:="TV Comodín", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    ActiveCell = Cell
    Cell.Select
    
    comodin = ActiveCell.Offset(0, 1).Value2

    Range("A2").Select
    Firstrow = ActiveCell.Row
    Selection.End(xlDown).Select
    Lastrow = ActiveCell.Row

    j = comodin 
While (j > 0)
        For i = 2 To Lastrow
        Range("B2").Select
        Range("B" & i) = Range("B" & i).Value + 1
        If j > 0 Then j = j - 1
        If j = 0 Then Exit For
   
    Next

Wend
          
End Sub

Basically, my code finds the "TV Comodin" row to get de number of times that the loop is gonna add 1 by 1 in every single row of its column,

Sorry, I'm a little bit new on VBA, thanks by the way.

Xkid
  • 338
  • 1
  • 4
  • 17

1 Answers1

0

Here's one approach. Find the smallest number in the range: add one. Repeat until you've done that (eg) 55 times.

Sub Prueba()
    Dim f As Range, ws As Worksheet, comodin As Long, rng As Range, m, mn
    
    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
        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
        Loop
    Else
        MsgBox "not found!"
    End If
End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • wow! that's great. I tried with this and it works! just one more question if you don't mind, but, how can I to add an additional condition? I mean, i forgot to ask but once the value where the loop is adding 1 by 1 gets to 100 it must to skip to the next one. I tried to an if inside the Do while sentence but it did not work...By the way, how can I give you the vote to correct answer? :) – Xkid Jan 09 '21 at 02:13
  • If no value can be >100 then as soon as the *minimum* is 100 then you'd need to stop adding altogether, right? There's no "next one" in that case See my edit above for how to exit the loop in that case. – Tim Williams Jan 09 '21 at 04:51