| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with loop sequence
Hi.
I could use some help setting up a loop sequence for my macro(macro as it is can be seen below). I need the macro to loop the sequence for a number of times until there is only empty rows in range B9:B35. Is that possible? Alternatively is it possible to enter the number of times the loop should repeat itself in a cell and have the macro read this number? Any help will be appreciated. -- Macro-- Sub FindCell() Sheets("CM").Select Dim cell As Range Dim rng As Range Range("A9:F35").Sort Key1:=Range("B9"), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal myValue = Range("J3").Value For Each cell In Range("B9:B35") If cell.Value < myValue Then cell.Select ActiveCell.EntireRow.Select Selection.Cut Sheets("Dataark").Select Range("A3").Select Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, Searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate ActiveSheet.Paste Set rng = Cells(Rows.Count, 2).End(xlUp) rng.Select ActiveCell.Copy Sheets("CM").Select Range("K3").Select ActiveSheet.Paste Selection.Font.ColorIndex = 2 Range("J3").Select ActiveCell.FormulaR1C1 = "=R[1]C[-8]-RC[1]" Exit Sub End If Next End Sub -- Macro End-- //Kasper |
|
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Help with loop sequence
1. Sub FindCell() Sheets("CM").Select Dim cell As Range Dim rng As Range Range("A9:F35").Sort Key1:=Range("B9"), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal myValue = Range("J3").Value For Each cell In Range("B9:B35") If Range("B9:B35").Rows.Count< Application.WorksheetFunction.CountBlank(Range("B9 :B35")) Then If cell.Value < myValue Then cell.Select ActiveCell.EntireRow.Select Selection.Cut Sheets("Dataark").Select Range("A3").Select Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, Searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate ActiveSheet.Paste Set rng = Cells(Rows.Count, 2).End(xlUp) rng.Select ActiveCell.Copy Sheets("CM").Select Range("K3").Select ActiveSheet.Paste Selection.Font.ColorIndex = 2 Range("J3").Select ActiveCell.FormulaR1C1 = "=R[1]C[-8]-RC[1]" Exit Sub End If End If Next cell End Sub 2. presuming the number for the loop to be repeated is in K3 Sub FindCell() Sheets("CM").Select Dim cell As Range Dim rng As Range Range("A9:F35").Sort Key1:=Range("B9"), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal myValue = Range("J3").Value For i =1 to Range("K3").Value For Each cell In Range("B9:B35") If Range("B9:B35").Rows.Count< Application.WorksheetFunction.CountBlank(Range("B9 :B35")) Then If cell.Value < myValue Then cell.Select ActiveCell.EntireRow.Select Selection.Cut Sheets("Dataark").Select Range("A3").Select Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, Searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate ActiveSheet.Paste Set rng = Cells(Rows.Count, 2).End(xlUp) rng.Select ActiveCell.Copy Sheets("CM").Select Range("K3").Select ActiveSheet.Paste Selection.Font.ColorIndex = 2 Range("J3").Select ActiveCell.FormulaR1C1 = "=R[1]C[-8]-RC[1]" Exit Sub End If End If Next cell Next i End Sub On 16 Gru, 11:06, Kasper wrote: Hi. I could use some help setting up a loop sequence for my macro(macro as it is can be seen below). I need the macro to loop the sequence for a number of times until there is only empty rows in range B9:B35. Is that possible? Alternatively is it possible to enter the number of times the loop should repeat itself in a cell and have the macro read this number? Any help will be appreciated. -- Macro-- Sub FindCell() Sheets("CM").Select Dim cell As Range Dim rng As Range Range("A9:F35").Sort Key1:=Range("B9"), Order1:=xlDescending, Header:= _ * * * * xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ * * * * DataOption1:=xlSortNormal myValue = Range("J3").Value For Each cell In Range("B9:B35") If cell.Value < myValue Then * *cell.Select * *ActiveCell.EntireRow.Select * *Selection.Cut * *Sheets("Dataark").Select * *Range("A3").Select * *Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, Searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate * *ActiveSheet.Paste * *Set rng = Cells(Rows.Count, 2).End(xlUp) * *rng.Select * *ActiveCell.Copy * *Sheets("CM").Select * *Range("K3").Select * *ActiveSheet.Paste * *Selection.Font.ColorIndex = 2 * *Range("J3").Select * *ActiveCell.FormulaR1C1 = "=R[1]C[-8]-RC[1]" * *Exit Sub End If Next End Sub -- Macro End-- //Kasper |
|
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Help with loop sequence
Nice...
Thank you very much However I do get an error in this part: If Range("B9:B35").Rows.Count< Application.WorksheetFunction.CountBlank(Range("B9 :B35")) Then Another question: The cell which tells the macro how many times to repeat itself is actually H7 and consists of a count command, =COUNT (A9:A100). Can this be integrated so I do not have to use a cell for it? Thank you //Kasper |
|
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Help with loop sequence
step by step?
;-) 1. out the whole expression in 1 line If Range("B9:B35").Rows.Count < Application.WorksheetFunction.CountBlank(Range("B9 :B35")) Then 2. For i =1 to Application.WorksheetFunction.Count(Range("A9:A100 ")) On 16 Gru, 12:00, Kasper wrote: Nice... Thank you very much However I do get an error in this part: If Range("B9:B35").Rows.Count< Application.WorksheetFunction.CountBlank(Range("B9 :B35")) Then Another question: The cell which tells the macro how many times to repeat itself is actually H7 and consists of a count command, =COUNT (A9:A100). Can this be integrated so I do not have to use a cell for it? Thank you //Kasper |
|
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
Help with loop sequence
Okay, you can see my macro below this text. I am still having
problems, the macro only runs one loop and then stops, I must be missing something... It doesn't report and error and functions as it should but it doens't loop they way I hoped... I would like it to loop until it has cut every row out with data in Range(A9:A100) :-) Sub Optimer() Sheets("CM").Select Dim cell As Range Dim rng As Range Range("A9:F35").Sort Key1:=Range("B9"), Order1:=xlDescending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal myValue = Range("J3").Value For i = 1 To Application.WorksheetFunction.Count(Range("A9:A100 ")) For Each cell In Range("B9:B35") If Range("B9:B35").Rows.Count < Application.WorksheetFunction.CountBlank(Range("B9 :B35")) Then If cell.Value < myValue Then cell.Select ActiveCell.EntireRow.Select Selection.Cut Sheets("Dataark").Select Range("A3").Select Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, Searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate ActiveSheet.Paste Set rng = Cells(Rows.Count, 2).End(xlUp) rng.Select ActiveCell.Copy Sheets("CM").Select Range("K3").Select ActiveSheet.Paste Selection.Font.ColorIndex = 2 Range("J3").Select ActiveCell.FormulaR1C1 = "=R[1]C[-8]-RC[1]" Exit Sub End If End If Next cell Next i End Sub //Kasper |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| sequence | Excel Discussion (Misc queries) | |||
| min and max in a sequence | Excel Worksheet Functions | |||
| Tab sequence | Excel Discussion (Misc queries) | |||
| Set tab sequence help | Excel Discussion (Misc queries) | |||
| the first in a sequence | Excel Discussion (Misc queries) | |||
Linear Mode
