VBA to Copy and Paste Rows if Conditions are Met

lpw0806 · Jun 14, 2018

Hi -

I am a first time poster on this site. I am still pretty green to VBA, but am learning and have made some small / short macros. I am familiar with SQL if that helps at all.

Right now I have a file with a "Raw Data" tab. I'd like to have a macro that states something like "IF Column A = "75" and Column B = "West" and Column C = "Local" etc etc then:

1) Create a new sheet titled 75
2) Paste that data into this new sheet.
--- note: Ideally I'd like to copy a handful of columns on the Raw Data tab instead of all of them.

I think there will need to be a "loop" involved here? Also - the number of rows is not sedentary and will always change.

Thanks in advance for the help on this!!! Much appreciated!

Fluff · Jun 14, 2018

Hi & welcome to MrExcel
How about

Code:

Sub FilterCopy()
   
   With Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
      If .AutoFilterMode Then .AutoFilterMode = False
      With .Range("[COLOR=#0000ff]A1:Z1[/COLOR]")
         .AutoFilter 1, 75
         .AutoFilter 2, "West"
         .AutoFilter 3, "Local"
      End With
      Sheets.Add(, Sheets(Sheets.Count)).Name = "75"
      .AutoFilter.Range.Copy Sheets("75").Range("A1")
      .AutoFilterMode = False
   End With
End Sub

Change sheet name in red & range in blue to suit.

lpw0806 · Jun 15, 2018

Omg!!! That really helped!! Thank you!! A few follow up questions:

Do these numbers (AutoFilter 1, AutoFilter 2, etc) reference the column that is being filtered? EX - AutoFilter 1 = Column A and AutoFilter 26 = Column Z?

.AutoFilter 1, 75
.AutoFilter 2, "West"
.AutoFilter 3, "Local"

Is there a way to only copy and paste certain columns? EX - only columns B, F, G, L-O

Is there a way to "loop" through the raw data to do multiple searches?
- EX - First search (what you already showed me) looks for "75", "West" and "Local" and pastes those values into a new sheet
- Then the macro would search for values with a different criteria (ex "50", "West" and "Local") - then a third search ("75", "West" and "National"), a fourth ("50", "West" and "National") etc etc

Thank you again for all of the help!! This was great!

Fluff · Jun 15, 2018

Do these numbers (AutoFilter 1, AutoFilter 2, etc) reference the column that is being filtered? EX - AutoFilter 1 = Column A and AutoFilter 26 = Column Z?

Yes they do, as long as the autofilter starts in Col A.
You can create an array for the filter criteria like

Code:

Sub FilterCopy()
   Dim ary As Variant
   ary = Array(75, "West", "Local", 50, "West", "local", 75, "West", "National")
   
   For i = 0 To UBound(ary) Step 3
      With Sheets("Sheet1")
         If .AutoFilterMode Then .AutoFilterMode = False
         With .Range("A1:Z1")
            .AutoFilter 1, ary(i)
            .AutoFilter 2, ary(i + 1)
            .AutoFilter 3, ary(i + 2)
         End With
         Sheets.Add(, Sheets(Sheets.Count)).name = "75"
         Intersect(.AutoFilter.Range, Range("B:B,F:G,L:O")).Copy Sheets("75").Range("A1")
         .AutoFilterMode = False
      End With
   Next i
End Sub

But what would the sheet names be?

lpw0806 · Jun 15, 2018

50, 75, 85, 95, 100

Fluff · Jun 15, 2018

So both 75, "West", "Local" and 75, "West", "National" would both go on sheet name 75.
Is that right?

lpw0806 · Jun 15, 2018

ahhh....good point. I was just using those fields as a sample but realize now that it's a little confusing - sorry about that

Here is a sample of the data. I'd like the macro to search the data and output tabs ( named 50, 75, 85, 95, 100) - but not include all of the columns listed.

Criteria

Opportunity Owner: Department = National, Probability (%) = 50
Opportunity Owner: Department = National, Probability (%) = 75
Opportunity Owner: Department = National, Probability (%) = 85
Opportunity Owner: Department = National, Probability (%) = 95
Opportunity Owner: Department = National, Probability (%) = 100

Columns to Include

Opportunity Owner
Account Name
Opportunity Name
Probability (%)
Previous Probability
Last Change Date
Duration Date
SP
DI
Total

Opportunity ID	Opportunity Owner	Opportunity Owner: Department	Probability (%)	Previous Probability	Account Name	Opportunity Name	Client Category	Type	Last Change Date	Duration Days	RV	SP	DI	Total
0064100000CMLWD	Bob Smith	Local	100	95	ABC123	XYZ123	Travel	New	6/6/2018	9	$190,000.00	$650,866.00	$941,439.00	$1,592,305.00
0064100000CMLY7	Bob Smith	Local	100	95	ABC124	XYZ124	Travel	New	5/30/2018	16	$117,188.00	$993,996.00	$682,723.00	$1,676,719.00
0064100000Chl2B	Bob Smith	Local	40	25	ABC125	XYZ125	Travel	New	6/14/2018	1	$35,000.00	$532,134.00	$878,368.00	$1,410,502.00
0064100000Egf7L	Bob Smith	Local	25	5	ABC126	XYZ126	Travel	New	6/7/2018	8	$50,000.00	$959,956.00	$923,252.00	$1,883,208.00
0064100000FEqmM	Bob Smith	Local	25	5	ABC127	XYZ127	Travel	New	5/31/2018	15	$50,000.00	$593,839.00	$297,582.00	$891,421.00
0064100000FyJGW	Bob Smith	Local	100	95	ABC128	XYZ128	Travel	Renewal	5/29/2018	17	$120,000.00	$995,399.00	$574,795.00	$1,570,194.00
0064100000GInah	Bob Smith	Local	75	50	ABC129	XYZ129	Travel	Renewal	6/13/2018	2	$26,000.00	$716,872.00	$531,627.00	$1,248,499.00
0064100000GInrJ	Bob Smith	Local	95	85	ABC130	XYZ130	Travel	Renewal	6/7/2018	8	$90,000.00	$638,496.00	$324,997.00	$963,493.00
0064100000GIo4N	Bob Smith	Local	100	95	ABC131	XYZ131	Travel	Renewal	5/29/2018	17	$41,000.00	$626,325.00	$782,363.00	$1,408,688.00
0064100000GIr1U	Bob Smith	Local	100	95	ABC132	XYZ132	Travel	Renewal	6/12/2018	3	$7,500.00	$971,209.00	$274,300.00	$1,245,509.00
0064100000GLmHb	Bob Smith	Local	100	95	ABC133	XYZ133	Travel	Renewal	6/4/2018	11	$28,848.00	$334,215.00	$735,878.00	$1,070,093.00
0064100000GLtlD	Bob Smith	National	50	5	ABC134	XYZ134	Travel	New	6/11/2018	4	$250,000.00	$771,801.00	$474,450.00	$1,246,251.00
0064100000GLusp	Bob Smith	National	75	40	ABC135	XYZ135	Travel	Renewal	5/29/2018	17	$400,000.00	$409,341.00	$738,747.00	$1,148,088.00
0064100000GM6IV	Bob Smith	Local	95	85	ABC136	XYZ136	Travel	Renewal	6/13/2018	2	$72,000.00	$989,813.00	$607,033.00	$1,596,846.00
0064100000HPWIg	Bob Smith	Local	100	95	ABC137	XYZ137	Travel	Renewal	6/4/2018	11	$152,000.00	$804,147.00	$870,487.00	$1,674,634.00
0064100000HPWMx	Bob Smith	Local	100	95	ABC138	XYZ138	Travel	Renewal	6/6/2018	9	$8,000.00	$836,409.00	$912,215.00	$1,748,624.00
0064100000HPWOe	Bob Smith	Local	100	95	ABC139	XYZ139	Travel	Renewal	5/30/2018	16	$76,808.00	$220,144.00	$914,156.00	$1,134,300.00
0064100000HPWXW	Bob Smith	Local	95	85	ABC140	XYZ140	Travel	Renewal	5/29/2018	17	$15,000.00	$133,979.00	$193,746.00	$327,725.00
0064100000HPWc2	Bob Smith	Local	95	85	ABC141	XYZ141	Travel	Renewal	5/29/2018	17	$46,000.00	$863,354.00	$149,726.00	$1,013,080.00
0064100000HPWdU	Bob Smith	Local	100	95	ABC142	XYZ142	Travel	Renewal	6/1/2018	14	$47,000.00	$295,988.00	$48,053.00	$344,041.00
0064100000HPWuG	Bob Smith	Local	95	85	ABC143	XYZ143	Travel	Renewal	6/13/2018	2	$36,000.00	$725,882.00	$740,921.00	$1,466,803.00
0064100000HPWvn	Bob Smith	Local	100	95	ABC144	XYZ144	Travel	Renewal	6/6/2018	9	$25,000.00	$205,745.00	$207,827.00	$413,572.00
0064100000IhMyZ	Bob Smith	National	95	85	ABC145	XYZ145	Travel	New	6/14/2018	1	$300,000.00	$683,260.00	$19,420.00	$702,680.00
0064100000JdGOp	Bob Smith	National	75	50	ABC146	XYZ146	Travel	New	5/29/2018	17	$300,000.00	$26,221.00	$472,009.00	$498,230.00
0064100000JtAA4	Bob Smith	Local	100	95	ABC147	XYZ147	Travel	Renewal	5/31/2018	15	$80,000.00	$51,442.00	$620,841.00	$672,283.00
0064100000LEQWb	Bob Smith	Local	95	75	ABC148	XYZ148	Travel	Renewal	5/30/2018	16	$35,000.00	$604,109.00	$485,938.00	$1,090,047.00
0064100000LEQoz	Bob Smith	Local	100	95	ABC149	XYZ149	Travel	Renewal	5/31/2018	15	$40,000.00	$198,456.00	$745,859.00	$944,315.00
0064100000LER66	Bob Smith	Local	100	95	ABC150	XYZ150	Travel	New	6/11/2018	4	$125,000.00	$228,145.00	$724,502.00	$952,647.00
0064100000LEctF	Bob Smith	Local	100	95	ABC151	XYZ151	Travel	Renewal	5/30/2018	16	$55,000.00	$46,831.00	$757,383.00	$804,214.00
0064100000LEpn5	Bob Smith	Local	95	75	ABC152	XYZ152	Travel	Renewal	5/30/2018	16	$175,000.00	$685,991.00	$241,713.00	$927,704.00
0064100000LF9Me	Bob Smith	Local	85	75	ABC153	XYZ153	Travel	Renewal	5/31/2018	15	$70,000.00	$26,335.00	$424,195.00	$450,530.00
0064100000LF9ND	Bob Smith	Local	100	95	ABC154	XYZ154	Travel	Renewal	6/6/2018	9	$38,571.00	$962,382.00	$377,739.00	$1,340,121.00

I tried to figure out how to upload a file but I can't....thank you again for your help with this!

Fluff · Jun 15, 2018

Ok, how about

Code:

Sub FilterCopy()
   Dim Ary As Variant
   Dim i As Long
   Ary = Array(50, 75, 85, 95, 100)
   
   For i = 0 To UBound(Ary)
      With Sheets("Sheet1")
         If .AutoFilterMode Then .AutoFilterMode = False
         With .Range("A1:O1")
            .AutoFilter 3, "National"
            .AutoFilter 4, Ary(i)
         End With
         Sheets.Add(, Sheets(Sheets.Count)).name = Ary(i)
         Intersect(.AutoFilter.Range, .Range("B:B,D:G,J:O")).Copy Sheets(CStr(Ary(i))).Range("A1")
         .AutoFilterMode = False
      End With
   Next i
End Sub

lpw0806 · Jun 19, 2018

AMAZING!!! IT WORKED!!!

THANK YOU

Last question - I swear.

I want to format the sheets after the output is finished. I recorded a macro of me doing the formatting.

1) Where in the above macro you wrote can I copy and paste it?
2) Do I have to rewrite it for each sheet? (50, 75, etc)?

THANK YOU AGAIN!!!

Code:

Sub Formatting()
'
' Formatting Macro
'


'
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("H:K").Select
    Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
    Range("F1").Select
    ActiveWorkbook.Worksheets("50").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("50").Sort.SortFields.Add Key:=Range("F1"), SortOn _
        :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("50").Sort
        .SetRange Range("A2:K10000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Fluff · Jun 19, 2018

Try

Code:

Sub Filtercopy()
   Dim ary As Variant
   Dim i As Long
   ary = Array(50, 75, 85, 95, 100)
   
   For i = 0 To UBound(ary)
      With Sheets("Sheet1")
         If .AutoFilterMode Then .AutoFilterMode = False
         With .Range("A1:O1")
            .AutoFilter 3, "National"
            .AutoFilter 4, ary(i)
         End With
         Sheets.Add(, Sheets(Sheets.Count)).name = ary(i)
         Intersect(.AutoFilter.Range, .Range("B:B,D:G,J:O")).Copy Sheets(CStr(ary(i))).Range("A1")
         .AutoFilterMode = False
      End With
   Next i
   For Each sht In ary
      With Sheets(CStr(sht))
         .UsedRange.EntireColumn.AutoFit
         .Range("H:K").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
         With .Sort
            .SortFields.Clear
            .SortFields.Add key:=Range("F1"), SortOn _
               :=xlSortOnValues, order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A2:K10000")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
         End With
      End With
   Next sht
End Sub

VBA to Copy and Paste Rows if Conditions are Met

lpw0806

New Member

Excel Facts

Fluff

MrExcel MVP, Moderator

lpw0806

New Member

Fluff

MrExcel MVP, Moderator

lpw0806

New Member

Fluff

MrExcel MVP, Moderator

lpw0806

New Member

Fluff

MrExcel MVP, Moderator

lpw0806

New Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

VBA to Copy and Paste Rows if Conditions are Met

New Member

Excel Facts

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

New Member

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock