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