Cut and move rows - loops

[Rutger54]

Hi,

I'm trying to cut rows with the word "FBO" in column B, and move them all to a new sheet, title that sheet "FBO Accounts", and delete the rows on the original tab where the FBO accounts were and would now be blank.

So an example: There are 100 accounts, 62 have FBO in the name which is in column B. I want those 62 accounts to be moved to a new tab which will be titled "FBO Accounts". The rows on the original tab where the "FBO" accounts were and are now blank as a result of being cut and pasted to the new tab, I would like to delete.

Thank you for any help I appreciate it!

 

[rallcorn]

Just curious, is sorting before & after cut/delete an option for you?

If it is, we'd approach the range that holds FBO, otherwise, we'd have to loop through each row.

Also, is FBO the only thing that is in the Col B cell? If not, is it always in the same place in the cell? Can you copy a small sample into post? (select in Excel, place border around selection and then cut & paste into poste)

 

[Rutger54]

Hi,

Unfortunately sorting isn't an option because, as you inferred, FBO is not necessarily in the same spot in each Column B.

As an example:

A B
125 Jack and Jill FBO
586 Eric FBO_mrk
8665 Kilo markets
8756 FBO conduit
745 empenada

So as mentioned, I'd want the rows with FBO to be cut and place in a new tab. I'd want to then delete these rows once they've been moved.

Thanks, again.

 

[rallcorn]

OK - for the below code I made the following assumptions:
1) Main sheet is named "OriginalSheet" without quotation marks - you'll have to revise accordingly
2) The "new tab" has already been created & named "FBO Accounts" without quotation marks (the macro is not creating that worksheet).
3) Row 1 in both sheets contains headings
4) There is no existing data in "FBO Accounts" sheet that needs to be cleared out prior to running the macro

Sub FBO()
Dim ColBlastrow As Long, LastCol As Long, i As Long, DestRow As Long
Dim MoveRange As Range
'In sample Col B is the column containing Account Name
ColBlastrow = Sheets("OriginalSheet").Range("B" & Rows.Count).End(xlUp).Row
'Loop through rows
'(working backwards since rows being deleted)
'Assumes Row 1 is header row & data begins in Row 2
For i = ColBlastrow To 2 Step -1
    Set myRange = Sheets("OriginalSheet").Range("B" & i)
 
    'Looks in the current Cell B for "FBO"
    'will return position number of character "F" if "FBO" is
    'found, zero if "FBO" is not found
    myPosition = InStr(1, myRange, "FBO", vbTextCompare)
 
    'What to do if "FBO" is found
    'if it is found, myPosition will be the
    'position number of character "F" in "FBO"
    'so myPosition will be >0
    If myPosition > 0 Then
 
        'Find the last column in row where "FBO" is found
        'working from far right to left in case there are blank columns
        'between populated columns
        LastCol = Cells(i, Columns.Count).End(xlToLeft).Column
 
        Set MoveRange = Range(Cells(i, 1), Cells(i, LastCol))
 
        MoveRange.Copy
 
        Sheets("FBO Accounts").Activate
 
        'Find the row into which the data should be placed
        DestRow = Sheets("FBO Accounts").Range("B" & Rows.Count).End(xlUp).Row + 1
 
            With Sheets("FBO Accounts").Range("A" & DestRow)
                .PasteSpecial Paste:=xlValues, Paste:=xlPasteFormats
                Application.CutCopyMode = False
            End With
 
        Sheets("OriginalSheet").Activate
        MoveRange.Delete
    End If
Next i
MsgBox ("Done!!")
End Sub

 

[Rutger54]

Rallcorn,

This worked beautifully! Thank you!!

 

[rallcorn]

You're welcome -- glad to help.