Hi

I need some help programming a macro that can select the first cell in
a row that is less than 8000(8000). Is it possible to do this via the
Cells.find command?

Hi Kasper

Add this to a module

Sub FindCell()
Dim cell As Range
For Each cell In Range("A1:K1")
If cell.Value < 8000 Then
cell.Select
Exit Sub
End If
Next
End Sub

HTH - Trevor Williams



"Kasper" wrote:

Hi

I need some help programming a macro that can select the first cell in
a row that is less than 8000(8000). Is it possible to do this via the
Cells.find command?

Hi,

thank you for your swift answer.
Do you know if the number(8000) can be replaced by a variable, eg.
cell E8 so the number which it enters is linked to the number i cell
E8?

Yes it can - use this...

Sub FindCell()
Dim cell As Range
myValue = Range("E8").value
For Each cell In Range("A1:K1")
If cell.Value < myValue Then
cell.Select
Exit Sub
End If
Next
End Sub

Trevor

"Kasper" wrote:

Hi,

thank you for your swift answer.
Do you know if the number(8000) can be replaced by a variable, eg.
cell E8 so the number which it enters is linked to the number i cell
E8?

Thank you

This works perfectly...
If I later on in the formula change the value(myValue) and then repeat
(loop) the process, will it then use the original value or use the new
value?

//Kasper

Hi Kasper

myValue will always be what's in cell E8, so if you run it once with 8000 in
cell E8 it will look for values <8000 - if you then change the value in cell
E8 to 2000 and re-run it, it will look for values <2000.

Have fun!

Trevor

"Kasper" wrote:

Thank you

This works perfectly...
If I later on in the formula change the value(myValue) and then repeat
(loop) the process, will it then use the original value or use the new
value?

//Kasper

Thanks again

Actually what I am trying to do is cut out the data of the original
sheet and paste the value of the first Coloumn in the selected Row to
J3(myValue) and then run the process again automatically. You can see
my code so far beneath.


Sub FindCell()
Sheets("CM").Select
Dim cell 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

Exit Sub
End If
Next
End Sub

Hi Kasper

Your code will work if you remove the 'Exit Sub' line

Here's a cleaner version:

Sub FindCell()
Dim cell As Range

Sheets("CM").Select
myValue = Range("J3").Value
Range("A9:F35").Sort Key1:=Range("B9"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

For Each cell In Range("B9:B35")
If cell.Value < myValue Then
cell.EntireRow.Cut
Sheets("Dataark").Range("A1000").End(xlUp).Offset( 1, 0).Insert
Shift:=xlDown
End If
Next
End Sub

Trevor.

"Kasper" wrote:

Thanks again

Actually what I am trying to do is cut out the data of the original
sheet and paste the value of the first Coloumn in the selected Row to
J3(myValue) and then run the process again automatically. You can see
my code so far beneath.


Sub FindCell()
Sheets("CM").Select
Dim cell 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

Exit Sub
End If
Next
End Sub

Thank you very much,

Currently my macro was:

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("J3").Select
ActiveSheet.Paste

Hi again

I like the simplicity of your code, but i doesn't seem to work quite
the way I intended. The problem is that "myValue" has to be changed
between each searchloop(if that is the right word).

Actually I need the rows copied to be grouoped in twos.
Each pair can not add up to more than 8664 when added together. E.g.
these are my data:
A B C
11 8500 4200
12 8400 2700
7 7500 4000
3 7000 2700
8 6800 3500
13 6000 2800
9 5400 2440
14 5400 2900
1 5200 2700
2 3600 2700
4 3600 2700
6 3500 2700
10 2500 4100
5 2400 2700


The macro has to pair two rows but their combined value in Coloumn B
can never be more than 8664 and then remove both rows from the
original datasheet and then do the same on the rest. Ending up in all
the data being grouped in the sheet "Dataark".
I don't expect you to write the whole macro for me but any help wil be
greatly appreciated... I have an idea of how to do it, but i'm not
quite sure if it will work..

//Kasper