IDENIFY cell.value in row. Once found, CUT row, and paste into New Sheet

[Sphinx404]

Howdy Monday Excel Experts,

I have an idea of how I need to organize the code, but there are facets of knowledge here that I'm not acquainted with and was hoping someone could help me out...

Trying to identify a value in a particular range, once that value is found, i need to CUT the entire row and paste it into a newly create sheet.

When I've found everything I need pull.. I need to go back through and delete all the blank rows I've just created through cut&paste.

Sub thirdparty()


Dim myWorksheet As Worksheet
Dim myLastRow As Long
Dim row As Long
Dim mycell As Range

ActiveWorkbook.Sheets("HazShipper").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set myWorksheet = Worksheets("HazShipper")
myLastRow = myWorksheet.Cells(myWorksheet.Rows.Count, "A").End(xlUp).row
row = 2


For Each mycell In Range("U2", Range("U" & myLastRow))


[COLOR=#ff0000]create new sheet here....???[/COLOR]


[COLOR=#ff0000]If mycell.Value = UPS, FEDEX, DHL, EXPO, CHARTER, or STERLING[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]then[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]CUT the entire ROW ("A:BA") and paste it into a newly created sheet called "3rd Party"(same workbook)[/COLOR]


row = row + 1


Loop


[COLOR=#ff0000]onces this loops through to the last row... I need to delete all the empty rows I just created through CUTTING and pasting.[/COLOR]


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

 

[Fluff]

No need for a loop. How about

Sub thirdparty()


Dim myWorksheet As Worksheet
Dim myLastRow As Long
Dim row As Long
Dim mycell As Range
Dim myarray As Variant

ActiveWorkbook.Sheets("HazShipper").Select
Application.ScreenUpdating = False
Application.DisplayAlerts = False

myarray = Array("UPS", "FEDEX", "DHL", "EXPO", "CHARTER", "STERLING")
Set myWorksheet = Worksheets("HazShipper")
myLastRow = myWorksheet.Cells(myWorksheet.Rows.Count, "A").End(xlUp).row

Sheets.Add(BEFORE:=Sheets(1)).Name = "3rd Party"
With myWorksheet
    If .AutoFilterMode Then .AutoFilterMode = False
    .Range("A1:BA1").AutoFilter 21, myarray, xlFilterValues
    .Range("A1:BA" & myLastRow).SpecialCells(xlVisible).copy Sheets("3rd Party").Range("A1")
    .Range("A2:BA" & myLastRow).SpecialCells(xlVisible).EntireRow.Delete
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

 

[Sphinx404]

Sheer VBA genius.

Perfect.

I think the array feature is awesome... I don't quite know how to incorporate it yet, but soon enough it'll be on my heels. Thank you @Fluff

 

[Fluff]

Glad to help & thanks for the feedback.

The good thing about using an array in this manner, is that if you have another 3rd party in future, you simply it to the array & the rest is taken care of. The same goes if you no longer want UPS in there, you simply delete it.