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]

The code runs....
However i have a couple of quick questions:

the code doesn't seem to write the 1 in column Z after being run....it does get reduced from G39 but the 1's never get written to the rows in column Z

and also, i wanted to ask if the code actually is smart enough to add 1 to the offset(0,-1) of the smallest number in AA but only once! meaning that if there is the following in AA:

4
4
4

and if 4 is the lowest number in AA, then the code "should" write 1's in the three rows in column Z BUT only take off 1 from G39.

Does it do this? cause i can't seem to see it when processing.

 

[Scott Huish]

The 1s?

I thought you wanted to add 1 to the number in Column AA and put that answer in Column Z next to it, is this not what you want?

 

[sssb2000]

actually, the code should find the lowest number in AA
that number may be repeated in consecutive rows....

-the code then adds 1 to all those rows IN COLUMN Z...
-subtracts ONLY 1 from G39

and then looks for the next lowest number after that (doen't consider the same number anymore) and does the same process until G39 is zero


I'm sorry if i didn't explained well

 

[Scott Huish]

So, the smallest number would have the number 1 next to them all, would the second smallest number then have 1 next to them all or would it be 2?

Is this correct?

 

[sssb2000]

you're absolutely right.
the next smallest number would also have all 1's

 

[Scott Huish]

OK, try this:

Sub test1()
Dim x As Long, y As Long, z As Long, w As Long
Dim c As Range, firstaddress
y = Range("G39")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("AA:AA"), x + w)
    w = w + Application.WorksheetFunction.CountIf(Range("AA:AA"), z)
    Set c = Worksheets("Sheet1").Range("AA:AA").Find(z, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstaddress = c.Address
            Do
                c.Offset(0, -1) = 1
                Set c = Worksheets("Sheet1").Range("AA:AA").FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
    Range("G39") = Range("G39") - 1
Next x
End Sub

 

[sssb2000]

it is so strange because i see G39 get reduced by the end of the code but the 1's are not written in column Z.
i don't understand!

 

[Scott Huish]

This was the result I had after running my macro:

addaa.xls
	Z	AA	AB	AC
964	1	4
965	1	4
966	1	4
967	1	4
968	1	4
969
970	1	9
971	1	9
972	1	9
973
974	1	29
975	1	29
976	1	29
977	1	29
978	1	29
979	1	29
980
981	1	56
982	1	56
983	1	56
984	1	56
985	1	56
986	1	56
Sheet1

 

[sssb2000]

the reason i was getting that error was becasue for me, the values in AA were calculated using a formula......a complicated one....
i deleted the formula and got the numbers some other way and your code worked

I have one question though...right now, the way that you have it set up, if the code sees the lowest number, it doesn't take into consideration that there are different sections within AA.
see, if 4 is the lowest number in a section in AA, 1 can be added to Z....and 1 unit should be subtracted from G39
if there is another section with the number 4 which becomes the lowest number next, then another 1 should be subtracted from G39

 

[Scott Huish]

OK, give this a try:

Sub test1()
Dim x As Long, y As Long, z As Long, w As Long
Dim c As Range, d As Range, firstaddress
y = Range("G39")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("AA:AA"), x + w)
    Set c = Worksheets("Sheet1").Range("AA:AA").Find(z, LookIn:=xlValues)
    Do While c.Offset(0, -1) = 1
        Set c = Worksheets("Sheet1").Range("AA:AA").FindNext(c)
    Loop
    w = w + c.CurrentRegion.Cells.Count
    For Each d In c.CurrentRegion
        d.Offset(0, -1) = 1
    Next
    Range("G39") = Range("G39") - 1
Next x
End Sub