Find Multiple criteria in a single column and paste data found in new worksheet

B

baywoman2001

New Member
Joined
Sep 17, 2013
Messages
2
I am new to forums and kind of desparate. I am trying to learn VBA and have an immediate need to solve an issue I have. I manage very large purchase history worksheets (+100K Rows each). I need a faster way to break down information. I have certain criteria I am looking to consolidate to prepare a mailing. Based on the order# I need to find 2 items from column E that match that order#. Here is an excerpt. If you notice an item was purchased but some returned. I want to filter the data and copy it to a new worksheet. Anyway I tried creating this code based on one I saw and am getting all kinds of errors. Please help if you can :banghead:
Sub MultipleCriteria()
Dim R As Range
Dim WSR As Worksheet ' Consolidated Sheet
Selection.AutoFilter
ActiveSheet.Range("$A$1:$N$10850").AutoFilter Field:=5, Criteria1:="3 YR*", Operator:=xlAnd
ActiveSheet.Range("$A$1:$N$10850").AutoFilter Field:=5, Criteria1:="Marriott TC*"
With ActiveCell.CurrentRegion
Set R = Range(.Cells(1, 1), .Cells(.Cells.Count))
End With
R.Copy
Set WSR = Worksheets.Add(after:=Worksheets("sheet10"))
' Sheets("sheet5").Select
Range("A1").Activate
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

[TABLE="width: 1516"]
<TBODY>[TR]
[TD]Order No
[/TD]
[TD]Marsha Code X2
[/TD]
[TD]Asset No
[/TD]
[TD]Inv Date
[/TD]
[TD]Material Description
[/TD]
[TD]Serial No
[/TD]
[TD]Quantity
[/TD]
[TD]Ship Name
[/TD]
[TD]Ship Street
[/TD]
[TD]SHIP_CITY
[/TD]
[/TR]
[TR]
[TD="align: right"]313187018
[/TD]
[TD]Abaco
[/TD]
[TD="align: right"]819989
[/TD]
[TD="align: right"]40610
[/TD]
[TD]MARRIOTT TC M58P USFF 3.00 6MB 2GB/160 V
[/TD]
[TD]1S6136A1UMJMPVD4
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abaco Club Rc Ltd. Operts Dept
[/TD]
[TD]6970 WALLIS RD UNIT 1C
[/TD]
[TD]WEST PALM BEACH
[/TD]
[/TR]
[TR]
[TD="align: right"]313187018
[/TD]
[TD]Abaco
[/TD]
[TD="align: right"]819998
[/TD]
[TD="align: right"]40610
[/TD]
[TD]MARRIOTT TC M58P USFF 3.00 6MB 2GB/160 V
[/TD]
[TD]1S6136A1UMJMPTY7
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abaco Club Rc Ltd. Operts Dept
[/TD]
[TD]6970 WALLIS RD UNIT 1C
[/TD]
[TD]WEST PALM BEACH
[/TD]
[/TR]
[TR]
[TD="align: right"]313996183
[/TD]
[TD]Abaco
[/TD]
[TD="align: right"]216924
[/TD]
[TD="align: right"]40879
[/TD]
[TD]MARRIOTT TC M91P SFF INTEL 3.1G 2GB 250G
[/TD]
[TD]1S7033A1UMJEDBAP
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abaco Club Rc Ltd. Operts Dept
[/TD]
[TD]6970 WALLIS RD UNIT 1C
[/TD]
[TD]WEST PALM BEACH
[/TD]
[/TR]
[TR]
[TD="align: right"]313996318
[/TD]
[TD]Abaco
[/TD]
[TD="align: right"]216955
[/TD]
[TD="align: right"]40879
[/TD]
[TD]MARRIOTT TC M91P SFF INTEL 3.1G 2GB 250G
[/TD]
[TD]1S7033A1UMJEDBGB
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abaco Club Rc Ltd. Operts Dept
[/TD]
[TD]6970 WALLIS RD UNIT 1C
[/TD]
[TD]WEST PALM BEACH
[/TD]
[/TR]
[TR]
[TD="align: right"]313996475
[/TD]
[TD]Abaco
[/TD]
[TD="align: right"]216956
[/TD]
[TD="align: right"]40879
[/TD]
[TD]MARRIOTT TC M91P SFF INTEL 3.1G 2GB 250G
[/TD]
[TD]1S7033A1UMJEDBTF
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abaco Club Rc Ltd. Operts Dept
[/TD]
[TD]6970 WALLIS RD UNIT 1C
[/TD]
[TD]WEST PALM BEACH
[/TD]
[/TR]
[TR]
[TD="align: right"]313791660
[/TD]
[TD]ABEBC
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40812
[/TD]
[TD]3 YR HARD DRIVE HOT SWAP FEE FOR MARRIOT
[/TD]
[TD](blank)
[/TD]
[TD="align: right"]2
[/TD]
[TD]ABEBC-Courtyard by Marriott
[/TD]
[TD]2220 EMRICK BLVD
[/TD]
[TD]BETHLEHEM
[/TD]
[/TR]
[TR]
[TD="align: right"]313791660
[/TD]
[TD]ABEBC
[/TD]
[TD="align: right"]213345
[/TD]
[TD="align: right"]40812
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJBABAC
[/TD]
[TD="align: right"]1
[/TD]
[TD]ABEBC-Courtyard by Marriott
[/TD]
[TD]2220 EMRICK BLVD
[/TD]
[TD]BETHLEHEM
[/TD]
[/TR]
[TR]
[TD="align: right"]313791660
[/TD]
[TD]ABEBC
[/TD]
[TD="align: right"]213346
[/TD]
[TD="align: right"]40812
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJBABAE
[/TD]
[TD="align: right"]1
[/TD]
[TD]ABEBC-Courtyard by Marriott
[/TD]
[TD]2220 EMRICK BLVD
[/TD]
[TD]BETHLEHEM
[/TD]
[/TR]
[TR]
[TD="align: right"]313605031
[/TD]
[TD]ABECY
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40764
[/TD]
[TD]3 YR HARD DRIVE HOT SWAP FEE FOR MARRIOT
[/TD]
[TD](blank)
[/TD]
[TD="align: right"]3
[/TD]
[TD]ABECY Courtyard By Marriott
[/TD]
[TD]2160 MOTEL DR
[/TD]
[TD]BETHLEHEM
[/TD]
[/TR]
[TR]
[TD="align: right"]313605031
[/TD]
[TD]ABECY
[/TD]
[TD="align: right"]210738
[/TD]
[TD="align: right"]40764
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJZLRD0
[/TD]
[TD="align: right"]1
[/TD]
[TD]ABECY Courtyard By Marriott
[/TD]
[TD]2160 MOTEL DR
[/TD]
[TD]BETHLEHEM
[/TD]
[/TR]
[TR]
[TD="align: right"]313605031
[/TD]
[TD]ABECY
[/TD]
[TD="align: right"]210739
[/TD]
[TD="align: right"]40764
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJYCCR2
[/TD]
[TD="align: right"]1
[/TD]
[TD]ABECY Courtyard By Marriott
[/TD]
[TD]2160 MOTEL DR
[/TD]
[TD]BETHLEHEM
[/TD]
[/TR]
[TR]
[TD="align: right"]313605031
[/TD]
[TD]ABECY
[/TD]
[TD="align: right"]210740
[/TD]
[TD="align: right"]40764
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJZLRD3
[/TD]
[TD="align: right"]1
[/TD]
[TD]ABECY Courtyard By Marriott
[/TD]
[TD]2160 MOTEL DR
[/TD]
[TD]BETHLEHEM
[/TD]
[/TR]
[TR]
[TD="align: right"]313121375
[/TD]
[TD]Abicy
[/TD]
[TD="align: right"]205419
[/TD]
[TD="align: right"]40588
[/TD]
[TD]MARRIOTT TC M58P USFF 3.00 6MB 2GB/160 V
[/TD]
[TD]1S6136A1UMJKXHF8
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abicy - Courtyard By Marriott
[/TD]
[TD]4350 RIDGEMONT DR
[/TD]
[TD]ABILENE
[/TD]
[/TR]
[TR]
[TD="align: right"]313498113
[/TD]
[TD]Abqca
[/TD]
[TD="align: right"]208919
[/TD]
[TD="align: right"]40709
[/TD]
[TD]MARRIOTT TC M58P SFF 3.00 6MB 2X1GB/160
[/TD]
[TD]1S6234A1UMJVYBD0
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqca - Courtyard By Marriott
[/TD]
[TD]1920 YALE BLVD SE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313593965
[/TD]
[TD]Abqca
[/TD]
[TD="align: right"]210448
[/TD]
[TD="align: right"]40746
[/TD]
[TD]MARRIOTT TC M91P SFF INTEL 3.1G 2GB 250G
[/TD]
[TD]1S7033A1UMJZGEH2
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqca - Courtyard By Marriott
[/TD]
[TD]1920 YALE BLVD SE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313844166
[/TD]
[TD]Abqca
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40843
[/TD]
[TD]3 YR HARD DRIVE HOT SWAP FEE FOR MARRIOT
[/TD]
[TD](blank)
[/TD]
[TD="align: right"]2
[/TD]
[TD]Abqca - Courtyard By Marriott
[/TD]
[TD]1920 YALE BLVD SE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313844166
[/TD]
[TD]Abqca
[/TD]
[TD="align: right"]214266
[/TD]
[TD="align: right"]40843
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJCDALN
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqca - Courtyard By Marriott
[/TD]
[TD]1920 YALE BLVD SE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313844166
[/TD]
[TD]Abqca
[/TD]
[TD="align: right"]214267
[/TD]
[TD="align: right"]40843
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJBWDYW
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqca - Courtyard By Marriott
[/TD]
[TD]1920 YALE BLVD SE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313930263
[/TD]
[TD]Abqcy
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40883
[/TD]
[TD]3 YR HARD DRIVE HOT SWAP FEE FOR MARRIOT
[/TD]
[TD](blank)
[/TD]
[TD="align: right"]2
[/TD]
[TD]Abqcy - Courtyard By Marriott
[/TD]
[TD]5151 JOURNAL CENTER BLVD NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313930263
[/TD]
[TD]Abqcy
[/TD]
[TD="align: right"]217250
[/TD]
[TD="align: right"]40883
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJDTVMG
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqcy - Courtyard By Marriott
[/TD]
[TD]5151 JOURNAL CENTER BLVD NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313930263
[/TD]
[TD]Abqcy
[/TD]
[TD="align: right"]217251
[/TD]
[TD="align: right"]40883
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJDTVTR
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqcy - Courtyard By Marriott
[/TD]
[TD]5151 JOURNAL CENTER BLVD NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313959019
[/TD]
[TD]Abqfa
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40877
[/TD]
[TD]3 YR HARD DRIVE HOT SWAP FEE FOR MARRIOT
[/TD]
[TD](blank)
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqfa - Fairfield Inn By Marriott
[/TD]
[TD]2300 CENTRE AVE SE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313452877
[/TD]
[TD]Abqri
[/TD]
[TD="align: right"]208246
[/TD]
[TD="align: right"]40690
[/TD]
[TD]MARRIOTT TC M58P SFF 3.00 6MB 2X1GB/160
[/TD]
[TD]1S6234A1UMJTPBA3
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqri - Residence Inn By Marriott
[/TD]
[TD]3300 PROSPECT AVE NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313612272
[/TD]
[TD]Abqri
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40751
[/TD]
[TD]3 YR HARD DRIVE HOT SWAP FEE FOR MARRIOT
[/TD]
[TD](blank)
[/TD]
[TD="align: right"]2
[/TD]
[TD]Abqri - Residence Inn By Marriott
[/TD]
[TD]3300 PROSPECT AVE NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313612272
[/TD]
[TD]Abqri
[/TD]
[TD="align: right"]210825
[/TD]
[TD="align: right"]40751
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJYCCN0
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqri - Residence Inn By Marriott
[/TD]
[TD]3300 PROSPECT AVE NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313612272
[/TD]
[TD]Abqri
[/TD]
[TD="align: right"]210829
[/TD]
[TD="align: right"]40751
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJYCCP4
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqri - Residence Inn By Marriott
[/TD]
[TD]3300 PROSPECT AVE NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313669178
[/TD]
[TD]Abqrn
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40767
[/TD]
[TD]3 YR HARD DRIVE HOT SWAP FEE FOR MARRIOT
[/TD]
[TD](blank)
[/TD]
[TD="align: right"]2
[/TD]
[TD]Abqrn - Residence Inn By Marriott
[/TD]
[TD]4331 THE LANE AT 25 NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313669178
[/TD]
[TD]Abqrn
[/TD]
[TD="align: right"]211773
[/TD]
[TD="align: right"]40767
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJAHBTD
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqrn - Residence Inn By Marriott
[/TD]
[TD]4331 THE LANE AT 25 NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]313669178
[/TD]
[TD]Abqrn
[/TD]
[TD="align: right"]211774
[/TD]
[TD="align: right"]40767
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJAHBTA
[/TD]
[TD="align: right"]1
[/TD]
[TD]Abqrn - Residence Inn By Marriott
[/TD]
[TD]4331 THE LANE AT 25 NE
[/TD]
[TD]ALBUQUERQUE
[/TD]
[/TR]
[TR]
[TD="align: right"]55235833
[/TD]
[TD]ABYFX
[/TD]
[TD="align: right"][/TD]
[TD="align: right"]40847
[/TD]
[TD]MARRIOTT TC M91P USFF INTEL 2.5G 2GB 250
[/TD]
[TD]1S5067A1UMJBABCX
[/TD]
[TD="align: right"]-1
[/TD]
[TD]ABYFX - Fairfield Inn By Marriott
[/TD]
[TD]2001 E 16TH AVE
[/TD]
[TD]CORDELE
[/TD]
[/TR]
</TBODY>[/TABLE]
 
Sort by date Sort by votes
With that much data, perhaps you should consider using Access instead of Excel. This is untested, but might be a better start...

Code: 
Option Explicit
Sub test()
    
    Dim rCopy As Range
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Application.ScreenUpdating = False
    
    'Check range is selected
    If TypeName(Selection) <> "Range" Then
        Exit Sub
    End If
    
    'set variables
    Set ws1 = ActiveSheet
    Set rCopy = Selection
    
    
    With ws1
        'Remove autofilter
        .AutoFilterMode = False
        With rCopy
            'Set filter
            .AutoFilter field:=5, Criteria1:="3 YR*", Operator:=xlAnd, Criteria2:="Marriott TC*"
        End With
        'Remove autofilter
        .AutoFilterMode = False
    End With
    
    'Set new variables
    Set rCopy = rCopy.SpecialCells(xlCellTypeVisible)
    Set ws2 = Worksheets.Add(after:=Sheets(ThisWorkbook.Sheets.Count))
    
    'Copy visible cells to new sheet
    rCopy.Copy
    ws2.Activate
    ws2.Range("A1").Select
    ActiveSheet.Paste
    
    Application.ScreenUpdating = False
    Application.CutCopyMode = xlCopy
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,226,849
Messages
6,193,330
Members
453,790
Latest member
yassinosnoo1

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top