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]

i started implementing the code......

See if the code works for you for the following example: (for me, it "forgets about" the number 6!)

non-Working v7 2-1-05 V2.xls
	Z	AA	AB	AC
19		4
20		4
21		4
22		4
23
24		6
25		6
26		6
27
28		5
29		5
30		5
31		5
32
33		4
34		4
35		4
36
37		55
38		55
39		55
40		55
41
42		7
43		7
44		7
45
46		9
47		9
48		9
Sheet2

 

[Scott Huish]

OK, try this:

Sub test1()
Dim x As Long, y As Long, z As Long, w As Long
Dim c As Range, d As Range
y = Range("G39")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("AA:AA"), 1 + 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

 

[sssb2000]

i see what you did....
that worked!


does this error mean anything to you:

"Unable to get the small property of the WorksheetFunction class"


it gives me that if i copy and past about 1000 lines of numbers in AA

 

[Scott Huish]

Is the number in G39 higher than the number of available sets of numbers?

If that's the case, this should fix it:

Sub test1()
Dim x As Long, y As Long, z As Long, w As Long
Dim c As Range, d As Range
On Error GoTo Finish
y = Range("G39")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("AA:AA"), 1 + 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
Finish:
End Sub

 

[sssb2000]

Goodmorning
actually, G39's value isn't higher than the number of available sets of numbers.
when i put in random numbers in AA by just typing them in, the code works flawlessly.....but as soon as i copy from a range that i have, or if i simply write a formula that looks at a different column's numbers (ie. =AB4 and hten scrol down), then no matter what number i put in G39, it'll put ALL 1's in the Z column and it subtracts ONLY 1 from G39.....it puts all 1's in Z, no matter what the number in AA is or even if it's blank.

 

[Scott Huish]

OK, see if this one works better:

Sub test1()
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("G39")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("AA:AA"), 1 + 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
    r1 = c.Row
    For r2 = r1 To 65536
        If Cells(r2, 27) <> z Then Exit For
    Next r2
    r2 = r2 - 1
    rct = (r2 - r1) + 1
    w = w + rct
    Range("AA" & r1 & ":AA" & r2).Offset(0, -1) = 1
    Range("G39") = Range("G39") - 1
    r1 = 0
    r2 = 0
    rct = 0
Next x
Finish:
End Sub

 

[sssb2000]

Hotpepper...thank you. that solved that problem.
you know, it's really interesting cause the code doesn't like numbers 12 and 21 in column AA!!!!!!!!
let me explain....if you run G39=1 for the following list of numbers:

non-Working v7 2-1-05 V2.xls
	Z	AA	AB	AC
11		212
12		212
13		212
14		212
15
16		33
17		33
18		33
19		33
20
21		44
22		44
23
24		21
25		21
26		21
27		21
Sheet2

you get:

non-Working v7 2-1-05 V2.xls
	Z	AA	AB	AC
10	1
11	1	212
12		212
13		212
14		212
15
16		33
17		33
18		33
19		33
20
21		44
22		44
23
24		21
25		21
26		21
27		21
Sheet2

do you know why?

 

[Scott Huish]

Yeah, and I think this should fix that. I could also add a line to clear out the Z column at the beginning if you want.

Sub test1()
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("G39")
If y <= 0 Then Exit Sub
For x = 1 To y
    z = Application.WorksheetFunction.Small(Range("AA:AA"), 1 + w)
    Set c = Worksheets("Sheet1").Range("AA:AA").Find(z, LookIn:=xlValues, LookAt:=xlWhole)
    Do While c.Offset(0, -1) = 1
        Set c = Worksheets("Sheet1").Range("AA:AA").FindNext(c)
    Loop
    r1 = c.Row
    For r2 = r1 To 65536
        If Cells(r2, 27) <> z Then Exit For
    Next r2
    r2 = r2 - 1
    rct = (r2 - r1) + 1
    w = w + rct
    Range("AA" & r1 & ":AA" & r2).Offset(0, -1) = 1
    Range("G39") = Range("G39") - 1
    r1 = 0
    r2 = 0
    rct = 0
Next x
Finish:
End Sub

 

[sssb2000]

Hotpepper,
that worked beautifully!
you changed the .xlvalues to .xlwhole but why?
i can't understand the logic?

also, about clearing the Z column, i have already done another function which automatically takes care of that before the main code is run. But thank you very much regardless.


listen, i can't ever thank you enough for all you've done. Thank you again you're great!

 

[Scott Huish]

Your welcome.

In answer to your question, I didn't change xlValues to xlWhole. Here is the line:

LookIn:=xlValues, LookAt:=xlWhole

I added the LookAt so it looks at the complete value in the cell before determining if a match is made to avoid problems like you mentioned.

For example, if 21 was a low value and 212 was first on the list in Column AA, it would match it because 21 is contained in that number, but by looking at the whole cell value, 21 would have to match completely the cell value and then 212 would not match.