Macro help! Please!

J

j33pguy

Well-known Member
Joined
Aug 6, 2004
Messages
633
Any help would be appreciated :)

Code: 
Sub Macro1()

   XX = 0
   Do Until XX = 30

   Application.ScreenUpdating = False
    Range("A3:C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("B3"), Order1:=xlDescending, Key2:=Range("C3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]>=R[1]C[-1],0,1)"
    Range("D3").Select
    Selection.Copy
    Range("D4").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A3:D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.LargeScroll Down:=-1
    Range("D5939").Select
    Selection.End(xlUp).Select
    Range("D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3:E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
       JJ = 3
    Do Until Range("E" & JJ) = 1
    If Range("E" & JJ) = 0 Then
    Range("E" & JJ).Select
    Selection.EntireRow.Delete
    JJ = JJ + 1
    
    End If
    
    Loop
    
    XX = XX + 1
    Loop
    Application.ScreenUpdating = True
End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
what help are you seeking? Does the macro fail? is so where? What are you trying to accomplish?
 
Upvote 0
Can you explain what you are trying to do?

Are you just trying to delete rows when a condition is met?
 
Upvote 0
this is what i'm doing:

1- i select A3:C5000 and sort as you can see
2- i apply a simple formula to D3 and drag all the way down
3- i copy column D's values, and past the values in E (values are 0 or 1)
4- i sort A3-E50000 so that all 0s in column E are on top
5- i delete the rows that have 0s in E
6- do the process over again 30 times (basically until E can get no more 0s)
 
Upvote 0
this is what i'm doing:

1- i select A3:C5000 and sort as you can see
2- i apply a simple formula to D3 and drag all the way down
3- i copy column D's values, and past the values in E (values are 0 or 1)
4- i sort A3-E50000 so that all 0s in column E are on top
5- i delete the rows that have 0s in E
6- do the process over again 30 times (basically until E can get no more 0s)
 
Upvote 0
But what are you trying to accomplish? I think the speed issue is due to the algorithm you are using more than anything else. Can we attack this problem in a different way?

If not, I think the problem is that when you sort the 0's to the top and start deleting, you index down a row each time meaning you skip every other 0. Try not incrementing JJ in the last loop. That may help some.
 
Upvote 0
my purpose is to draw the frontier line (the optimal points) through the 50000 points! column B is the risk, column C is the Cost and so i have 50000 points.
 
Upvote 0
i think that the problem is with the deleting of the row!
it takes a lonnng long time!

any ways around this?
how about if i simply "clear" the content of the row?
 
Upvote 0
for some reason, when i run this code using F8, it seems to run fine even though it's slow...but when i run the macro by itself, it hangs up (as if it's taking forever) but it doesn't give an error.

any suggestions?

Code: 
Sub Macro1()

   XX = 0
   Do Until XX = 30

   Application.ScreenUpdating = False
    Range("A3:C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("B3"), Order1:=xlDescending, Key2:=Range("C3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("D3").FormulaR1C1 = "=IF(RC[-1]>=R[1]C[-1],0,1)"
    Range("D3").Copy
    Range("D4").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A3:D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.LargeScroll Down:=-1
    Range("D5939").End(xlUp).Select
    Range("D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3:E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
       JJ = 3
    Do Until Range("E" & JJ) = 1
    If Range("E" & JJ) = 0 Then
    Range("E" & JJ).EntireRow.Delete
    JJ = JJ + 1
    
    End If
    
    Loop
    
    XX = XX + 1
    Loop
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question
Macro not working after adding two new items
Replies
4
Views
110
myall_blues
myall_blues
C
  • Question
Daily Run data (copy data in loop by daily in worksheet)
Replies
3
Views
162
dermie_72
D
S
  • Question
How to streamline?
Replies
2
Views
171
sachavez
S
P
  • Solved
Recorded Macro Ammendments
Replies
3
Views
346
Joe4
Joe4
M
  • Solved
Replacing delete with a value
Replies
3
Views
165
Alex Blakenburg
A

Forum statistics

Threads
1,215,054
Messages
6,122,893
Members
449,097
Latest member
dbomb1414

Share this page

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