Copy Rows Based on a Single Column Multiple Values

[slpswhite]

I have a workbook which I need to copy rows to a new worksheet. One of the columns is called Vendor. I have 12 different vendors, but 3 of them have different entries. Let's say column "C" is the vendor column and contains the following:

Vendor 1
Vendor 1 Onshore
Vendor 1 Offshore
Vendor 2
Vendor 2 Onshore
Vendor 2 Offshore
Vendor 3
Vendor 4
Vendor 5

What I need to do is copy all Vendor 1's to a new worksheet. So when the value of column "C" is any of the following Vendor 1, Vendor 1 Onshore, or Vendor 1 Offshore it is copied to the new workbook.

I have the following code which of course only works for the entry I input.

Private Sub Workbook_Open()
Dim i, LastRow


Set ws1 = Sheets("Raw Data SP")
Set ws2 = Sheets("Vendor")
LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
ws2.Range("A2:S1000").ClearContents
For i = 2 To LastRow
If ws1.Cells(i, "C").Value = "Vendor 1" Then
ws1.Cells(i, "C").EntireRow.Copy Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub

 

[mumps]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Raw Data SP").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Raw Data SP").Range("C1:C" & LastRow).AutoFilter Field:=1, Criteria1:="=Vendor 1*"
    Sheets("Raw Data SP").Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Vendor").Cells(Sheets("Vendor").Rows.Count, "A").End(xlUp).Offset(1, 0)
    If Sheets("Raw Data SP").AutoFilterMode = True Then Sheets("Raw Data SP").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[slpswhite]

This is perfect and does exactly what I needed. Thanks!

 

[mumps]

You are very welcome.

 

[slpswhite]

This has been working great, however I ran into a small problem. It seems if I have a Vendor who is missing for a reporting period it causes an error. For instance Vendor B also has a worksheet called Vendor B, if they are not in the data I am trying to copy over it kicks an error. If I add the Vendor in column where the macro expects it it works great. Is there a way I can either change the code so it will either skip over the error or better yet if the name is not there to ignore the copying part of the code?

 

[Fluff]

How about this mod to mumps code

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Raw Data SP").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Raw Data SP").Range("C1:C" & LastRow).AutoFilter Field:=1, Criteria1:="=Vendor 1*"
    [COLOR=#0000ff]On Error Resume Next[/COLOR]
    Sheets("Raw Data SP").Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Vendor").Cells(Sheets("Vendor").Rows.Count, "A").End(xlUp).Offset(1, 0)
    [COLOR=#0000ff]On Error GoTo 0[/COLOR]
    If Sheets("Raw Data SP").AutoFilterMode = True Then Sheets("Raw Data SP").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub