Question on modifying a Macro..........

[sssb2000]

hi,
i have the following code for doing a procedure......i was hoping i could ask for a little help regarding modifying it a little....

First to tell you what the code does......
Right now, it searches through column AA; searches for the lowest number; if it finds the cell with the lowest value in AA, it then adds a 1 to the row to the left of it....the code then subtracts 1 from G39 and does the same process again.....until G39 has a value of zero

Now the problem is that before, i used to have the sections in AA merged....so what you had was ONE 131, ONE 26 and ONE 139
Now what i've done is that i've expanded those merged cells and so now 131 shows on every cell whithin that section (note that in the example i'm posting, i have 3 sections.....each section has the same number)

How do i modify this code so that it searches AA but considers 131 only once as oppose to considering it as many rows as there are?

non-Working v7 1-28-05.xls
	Z	AA	AB	AC
1372
1373		131
1374		131
1375		131
1376		131
1377		131
1378		131
1379		131
1380		131
1381		131
1382		131
1383
1384		36
1385		36
1386		36
1387		36
1388		36
1389		36
1390		36
1391		36
1392
1393		139
1394		139
1395		139
1396		139
1397		139
1398		139
Sheet1

Sub evenout(rngaddone As Range)
Dim rng As Range, x&, cell As Range

'***************************************************
'ADDONE IS THE RANGE IN COLUMN AA
Set addone = rngaddone.Offset(0, 17).Cells(1)
'MsgBox Range((addone.Address)).Value
'Exit Sub
'***************************************************

If Not IsNumeric([G39]) Or [G39] = 0 Or Len([G39]) = 0 Then Exit Sub
Set rng = Range([AA1], [AA65536].End(xlUp))
 
If [G39] > Application.WorksheetFunction.Count(rng) Then
    For Each cell In rng
        
        If IsNumeric(cell) And Len(cell)<> 0 Then
            [G39] = [G39] - 1
            cell.Offset(0, -1) = cell.Offset(0, -1) + 1
        End If
    Next
Else
    x = Application.WorksheetFunction.Small([aa:aa], [G39])
    For Each cell In rng
        If IsNumeric(cell) And Len(cell)<> 0 And cell<= x Then
            [G39] = [G39] - 1
            cell.Offset(0, -1) = cell.Offset(0, -1) + 1
            If [G39] = 0 Then Exit For
        End If
    Next
End If


End Sub

 

[sssb2000]

aahhh! that's smart!

I just remembered that you once asked me to make sure that "there is an empty cell between each section"? ....and i said yes.

why is that so significant? how could the code work if there is a situation when all the numbers are right after one another and there isn't an empt cell between?

 

[Scott Huish]

I changed my code to deal with that, so it's not an issue anymore, but at the time I was using the blank cells in conjunction with CurrentRegion to determine where each block of numbers was. I eliminated this in the most recent versions of my code.

 

[sssb2000]

you're right! my mistake


thank you so much Hotpepper

 

[sssb2000]

hi Hotpepper
hope you're doing well...
remember the code you helped me with?

Well, if you also remember, there was an issue we were talking about regarding spaces between the numbers....it turns out that there will be no spaces! So there needs to be an identifier by which the numbers are seperated! in this case, there is a unique identifier in column J.


so if in column J we have:

jack
jack
jack
kevin
kevin
kevin
kevin
kevin

and in column AI we have:

4
4
4
4
4
4
4
4

then the code would know that it would seperate between the fours and not consider them all as the same number.

the last code that you gave me worked great with the spaces....but when situations like the above came up, then it put a 1 for all 8 numbers and only reduced 1 unit from CQ41 when it should have reduced 2!

is there anyway you could tell me how to modify that code to fix that issue? Please

Sub evenout()
Dim x As Long, y As Long, z As Long, w As Long, r1 As Long, r2 As Long, rct As Long
Dim c As Range, d As Range
On Error GoTo Finish
y = Range("cq41")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("Ai:Ai"), 1 + w)
    Set c = Worksheets("Sheet1").Range("Ai:Ai").Find(z, LookIn:=xlValues, LookAt:=xlWhole)
    Do While c.Offset(0, -1) = 1
        Set c = Worksheets("Sheet1").Range("Ai:Ai").FindNext(c)
    Loop
    r1 = c.Row
    For r2 = r1 To 65536
        If Cells(r2, 35) <> z Then Exit For
    Next r2
    r2 = r2 - 1
    rct = (r2 - r1) + 1
    w = w + rct
    Range("Ai" & r1 & ":Ai" & r2).Offset(0, -1) = 1
    Range("cq41") = Range("cq41") - 1
    r1 = 0
    r2 = 0
    rct = 0
Next x
Finish:
End Sub

 

[Scott Huish]

Try this:

Sub evenout_TEST()
Dim x As Long, y As Long, z As Long, w As Long, r1 As Long, r2 As Long, rct As Long
Dim c As Range, d As Range, n1 As String
On Error GoTo Finish
y = Range("cq41")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("AI:AI"), 1 + w)
    Set c = Worksheets("Sheet1").Range("AI:AI").Find(z, LookIn:=xlValues, LookAt:=xlWhole)
    Do While c.Offset(0, -1) = 1
        Set c = Worksheets("Sheet1").Range("AI:AI").FindNext(c)
    Loop
    r1 = c.Row
    n1 = Worksheets("Sheet1").Cells(r1, 10)
    For r2 = r1 To 65536
        If Cells(r2, 35) <> z Or Worksheets("Sheet1").Cells(r2, 10) <> n1 Then Exit For
    Next r2
    r2 = r2 - 1
    rct = (r2 - r1) + 1
    w = w + rct
    Range("AI" & r1 & ":AI" & r2).Offset(0, -1) = 1
    Range("CQ41") = Range("CQ41") - 1
    r1 = 0
    r2 = 0
    rct = 0
    n1 = ""
Next x
Finish:
End Sub

 

[sssb2000]

Hotpepper, thank you very much once again

i'm assuming that this line of code basically looks at column J and takes that into account when searching for numbers in column AI

n1 = Worksheets("Sheet1").Cells(r1, 10) 
    For r2 = r1 To 65536 
        If Cells(r2, 35) <> z Or Worksheets("Sheet1").Cells(r2, 10) <> n1 Then Exit For

is that true?

sorry...the reason i'm asking is to learn...the code works flawlessly

also, i have another clarifying point....if i wanted this code to look for the largest number in column AI as oppose to the smallest, (not that i do, i was just thinking about that this morning ), would the following code only change small to large?

z = Application.WorksheetFunction.Small(Range("AI:AI"), 1 + w)

thank you again for everything

 

[Scott Huish]

Yes, this code is looking for a change in the value in Column J.

n1 = Worksheets("Sheet1").Cells(r1, 10) 
    For r2 = r1 To 65536 
        If Cells(r2, 35) <> z Or Worksheets("Sheet1").Cells(r2, 10) <> n1 Then Exit For

Changing Small to Large should work for finding the highest values instead.

 

[sssb2000]

Hotpepper,
i tried running the code for 6500 rows of number (with numbers ranging from 1 digit to 4 digits), and the number to be added was 89....
after the ones were distributed, the total came 12 short....meaning that only 77 were distributed!
i don't understand this problem....

i went back and started adding less numbers....it adds upto 30 numbers without any problem.....but when i type in 31 to be distributed, it starts not accounting properly.

i looked at the code, and it seemed like it was taking everything into consideration....
can you think of anything? do you see any potential problems?