If statement, Offset, Copy, Paste or Move Down

[Bobaree6]

Could someone help this beginner with this process?

I need to start at a cell in column M

If the number in the chosen cell in column M is <=1%,

Offset 11 cells to the left. Select that cell and the cell adjacent to it on the right.

Copy those two cells and paste to $X$9 and $Y$9.

If, on the other hand, the number in the selected cell is >1%

The cursor would move down column M until it finds the next cell with <=1%

Offset 11 cells to the left. Select that cell and the cell adjacent to it on the right.

Copy those two cells and paste to $X$9 and $Y$9

The cursor then goes back to the cell in column M that had the <=1% figure and stops.

End

 

[mrshl9898]

Like this?

Sub DoTheThing()

Dim myrow As Long
Dim success As Long

myrow = Selection.Row
success = 0

Do Until success = 1
If Cells(myrow, 13) <= 0.01 Then
    Cells(myrow, 2).Copy Range("X9")
    Cells(myrow, 3).Copy Range("Y9")
    success = 1
Else
    myrow = myrow + 1
    Cells(myrow, 13).Select
End If
Loop


End Sub

 

[Alex Blakenburg]

See if this is what you had in mind.

Sub CopyFromM()

    Dim rowNo As Long
     
    'Check the cell selected is in column M
    If ActiveCell.Column = 13 Then
        rowNo = ActiveCell.Row
        
        'Loop until cell meets criteria or you get to a blank cell (end of the data)
        Do While Cells(rowNo, "M").Value > 0.01 And Not IsEmpty(Cells(rowNo, "M"))        
            rowNo = rowNo + 1        
        Loop
               
        If Not IsEmpty(Cells(rowNo, "M")) Then
            'If loop finished and not because it reached an empty cell perform action
            Range("X9:Y9").Value = Cells(rowNo, "M").Offset(0, -11).Resize(1, 2).Value
            Cells(rowNo, "M").Activate
        End If
    
    End If

End Sub

 

[Bobaree6]

Like this?

Sub DoTheThing()

Dim myrow As Long
Dim success As Long

myrow = Selection.Row
success = 0

Do Until success = 1
If Cells(myrow, 13) <= 0.01 Then
    Cells(myrow, 2).Copy Range("X9")
    Cells(myrow, 3).Copy Range("Y9")
    success = 1
Else
    myrow = myrow + 1
    Cells(myrow, 13).Select
End If
Loop


End Sub

This works, Sir. Thank you so much. I was hoping it would search out the next figure <0.01 in the same column when I pressed the short-cut key again, but I don't want to be greedy in my requests.

 

[Bobaree6]

Like this?

Sub DoTheThing()

Dim myrow As Long
Dim success As Long

myrow = Selection.Row
success = 0

Do Until success = 1
If Cells(myrow, 13) <= 0.01 Then
    Cells(myrow, 2).Copy Range("X9")
    Cells(myrow, 3).Copy Range("Y9")
    success = 1
Else
    myrow = myrow + 1
    Cells(myrow, 13).Select
End If
Loop


End Sub

This works, Sir. Thank you so much. I was hoping it would search out the next figure <0.01 in the same column when I pressed the short-cut key again, but I don't want to be greedy in my requests.

 

[mrshl9898]

You'd need to run an alternate macro as far as I am aware.

*I'd also add @Bobaree6 IF statement to make sure you are on Column M perhaps.

I'd

Sub DoTheThing()

Dim myrow As Long
Dim success As Long

If ActiveCell.Column = 13 Then ''added

myrow = Selection.Row + 1  ''changed
success = 0

Cells(myrow,13).Select ''added

Do Until success = 1
If Cells(myrow, 13) <= 0.01 Then
    Cells(myrow, 2).Copy Range("X9")
    Cells(myrow, 3).Copy Range("Y9")
    success = 1
Else
    myrow = myrow + 1
    Cells(myrow, 13).Select
End If
Loop

end if ''added

End Sub

 

[Bobaree6]

Thanks, mrshl9898 for the info and updated advice.