Find 2 Match Words Then Cut Selected data to..

[bernardng]

I need to write a coding to identified the specified row is stated Completed or Not Completed, If Completed the selected row will cut and paste to Completed Task (Next Sheet), Not Completed will move down to bottom.

I have wrote a coding with using FIND method to searching the Completed word, if this word found, then cut the specified row or rows and do the paste.

The problem i have found is, Let say there is two "Completed" rows in my worksheet, i need to click twice commandbutton in order to Find this words. Is there any method to be done once button clicks, ALL Completed rows will automaticaly move & cut to next sheets.


Private Sub CommandButton3_Click()

Dim fRange As Range

On Error Resume Next
Set fRange = Range("A18:F37").Find(What:="Completed", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Cell.FindNext(After:=ActiveCell).Activate
Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -5)).Cut Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1)

End Sub


Please help on this!!

Rgds
Bernard (MIS- Excel Programmer Beginner)

 

[Loomah]

Bernard
If you check out the help file for the Find method you should find an example that loops until it has found every occurance of what ever you re looking for

Alternatively you could try to do something by filtering out the data you require.

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[bernardng]

Thanks for Ur reply, but honestly I do seach for it, But i do not understand of it and dont know how use Loop Method to apply at Find Method that u mentioned, If you do so,please help me! Thanks a lot!

 

[Loomah]

Hi Bernard
One possible way of looping through your data is:-

Sub a()
Dim found As Range
    Do
        Set found = Worksheets("source").Columns(1).Cells.Find("Comp", lookat:=xlWhole)
            If Not found Is Nothing Then
                found.EntireRow.Cut Worksheets("dest").Cells((Worksheets("dest").[a65536].End(xlUp).Row) + 1, 1)
            End If
    Loop While Not found Is Nothing
End Sub

However this will leave you with gaps in your data which is never a good thing. You could have another proceedure to go through the data and delete all the now empty rows or you could even do it as you go, but htis could be time consuming.

Another alternative would be to sort the data so that you have all the Completes at the top (assumes the column only contains "Complete" or "Not Complete"). You could then cut, paste and delete in one move without the need to loop. An example is given below

Sub b()
Dim found As Range
    With Worksheets("Source")
        .Cells.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        Set found = .Columns(1).Cells.Find("Comp", , , xlWhole, , xlPrevious)
            If Not found Is Nothing Then
                With .Range(.Cells(2, 1), .Cells(found.Row, 1)).EntireRow
                    .Cut Worksheets("dest").Cells((Worksheets("dest").[a65536].End(xlUp).Row) + 1, 1)
                    .Delete
                End With
            End If
        Set found = Nothing
    End With
End Sub

There are other options - the first that springs to mind is to filter the data and copy what you want (and it would have to be copy not cut for this method). but this should give you a start.

You will obviously have to adapt the code I've given here but if you run into problems with that just post back!

Good Luck




;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​