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

sssb2000

Well-known Member
Joined
Aug 17, 2004
Messages
1,169
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
ZAAABAC
1372
1373131
1374131
1375131
1376131
1377131
1378131
1379131
1380131
1381131
1382131
1383
138436
138536
138636
138736
138836
138936
139036
139136
1392
1393139
1394139
1395139
1396139
1397139
1398139
Sheet1




Code:
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
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
I did not test this, but it should work?

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 cell.Value = myValue Then Next cell

If IsNumeric(cell) And Len(cell) <> 0 Then
[G39] = [G39] - 1
cell.Offset(0, -1) = cell.Offset(0, -1) + 1
End If

myValue = cell.Value

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

myValue = cell.Value

Next
End If


End Sub
 
Upvote 0
Hi,
thanks for your reply.

when i try to run the below code, i get an error saying "Next without For" and it highlights this line of code: "If cell.Value = myValue Then Next cell"

also, i don't see where Myvalue is defined! :)


Any further suggestions please?


Code:
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 cell.Value = myValue Then Next cell

If IsNumeric(cell) And Len(cell) <> 0 Then
[G39] = [G39] - 1
cell.Offset(0, -1) = cell.Offset(0, -1) + 1
End If

myValue = cell.Value

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

myValue = cell.Value

Next
End If
 
Upvote 0
Try this:

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

'***************************************************
'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 cell.Value = myValue Then GoTo myNext

If IsNumeric(cell) And Len(cell) <> 0 Then
[G39] = [G39] - 1
cell.Offset(0, -1) = cell.Offset(0, -1) + 1
End If

myValue = cell.Value

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

myValue = cell.Value

:myNext
Next
End If


End Sub
 
Upvote 0
thank you for the reply :)

when i run it, it says "subfunction or function not defined" and it highlights ":mynext"
Also, in the line "if cell.value = myvalue then goto mynext".....what is Myvalue and where is it defined?

:) thanks
 
Upvote 0
myValue is the cell value test that looks for the same value in the next cell, if "myValue" is the same value as the next cell then go to the cell after that and look again. This is how I am avoiding more than one return per like group.

Also I did not set up a sheet to test this with so I am working blind here:

Try this:

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

'***************************************************
'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 cell.Value = myValue Then
GoTo myNext
End If

If IsNumeric(cell) And Len(cell) <> 0 Then
[G39] = [G39] - 1
cell.Offset(0, -1) = cell.Offset(0, -1) + 1
End If

myValue = cell.Value

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

myValue = cell.Value

:myNext
Next
End If


End Sub
 
Upvote 0
i understand now what the Myvalue is/does
what about Mynext? i'm getting the same error on that....it says: "sub or function not defined"


i'm running the code on something similar to this:
non-Working v7 1-31-05.xls
ZAAABAC
9644
9654
9664
9674
9684
969
9709
9719
9729
973
97429
97529
97629
97729
97829
97929
980
98156
98256
98356
98456
98556
98656
Sheet1
 
Upvote 0
Try this:

Code:
Sub test1()
Dim x As Long, y As Long, z As Long, w As Long
Dim c As Range
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)
    With Worksheets(1).Range("AA:AA")
        Set c = .Find(z, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Offset(0, -1) = z + 1
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
    Range("G39") = Range("G39") - 1
Next x
End Sub
 
Upvote 0
thank you Hotpepper,
but when i run the code, it gives an error and says:
"object variable or with block variable not set" and it highlights this line:
"Loop While Not c Is Nothing And c.Address <> firstAddress"

I'm not sure what this is....but could it be due to the fact that in AA, there may be blanks somewhere? for example you may have:

4
4
4

"blank"
"blank"

56
56
56

7
7


etc.

just a thought
 
Upvote 0
Blanks in AA should not be an issue, but here it is again with a couple of minor changes, see if this works any better:

Code:
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) = z + 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
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top