Copy Specific Columns from a Filtered Range

Hi,

Just came across this post, it looks like it can be tweaked a bit to suit my requirement (I'm do not want to copy all columns from source worksheet).

Export Chunks of Data into New Workbooks

I've enclosed a sample workbook with data & my requirements.

My Requirements (refer data in the Sample file attached)

My Source data starts from Row 5 (excluding Header in Row 4). I want to generate two sheets from this data and save them as as two csv files separately.

To populate Prod Sheet,
1. Apply filter on column L and exclude unmatched rows (#N/A)
2. Apply filter on Remarks column (W) and exclude the value Innov
3. Copy columns P and F into a new sheet and insert a column with value as "Add" (contents of Prod sheet)

To populate Innov Sheet,
1. Apply filter on column L and exclude unmatched rows (#N/A)
2. Apply filter on Remarks column (W) and exclude the value Prod
3. Copy columns S and F into a new sheet and insert a column with value as "Add" (contents of Innov sheet)

Let me know if you need any other information.

Can someone help me tweak the code in the above thread ?

Saarang,

Are you putting headers into the Prod and Innov sheets? I can modify the code if you are not... but right now it would be best if you do, if not you will have a blank row at the top of those sheets with this code, but as I said it can be dealt with if required.

Sub Saarang()

Dim ws As Worksheet, wsprod As Worksheet, wsinn As Worksheet
Dim lr As Long, i As Long

Set ws = Worksheets("Source")
Set wsprod = Worksheets("Prod")
Set wsinn = Worksheets("Innov")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 5 To lr
    If ws.Range("L" & i).Text <> "#N/A" And ws.Range("W" & i).Value <> "Innov" Then
        wsprod.Range("A" & wsprod.Range("A" & Rows.Count).End(xlUp).Row + 1).Value = "Add"
        wsprod.Range("B" & wsprod.Range("A" & Rows.Count).End(xlUp).Row).Value = ws.Range("P" & i).Value
        wsprod.Range("C" & wsprod.Range("A" & Rows.Count).End(xlUp).Row).Value = ws.Range("F" & i).Value
    End If
    If ws.Range("L" & i).Text <> "#N/A" And ws.Range("W" & i).Value <> "Prod" Then
        wsinn.Range("A" & wsinn.Range("A" & Rows.Count).End(xlUp).Row + 1).Value = "Add"
        wsinn.Range("B" & wsinn.Range("A" & Rows.Count).End(xlUp).Row).Value = ws.Range("S" & i).Value
        wsinn.Range("C" & wsinn.Range("A" & Rows.Count).End(xlUp).Row).Value = ws.Range("F" & i).Value
    End If
Next i

End Sub

BIG thanks to Arkadi and K64 for their codes !! My requirement is resolved !!

Hi Saraang,

Here is my code:

Sub filter_copy()
With Sheets("Source").UsedRange
    .AutoFilter 12, "<>#N/A"
    .AutoFilter 23, "<>Innov"
    Sheets("Prod").Cells.Clear
    Intersect(.Rows, .Range("P5:P10000")).Copy Sheets("Prod").Range("B1")
    Intersect(.Rows, .Range("F5:F10000")).Copy Sheets("Prod").Range("C1")
    Sheets("Innov").Cells.Clear
    .AutoFilter 23, "<>Prod"
    Intersect(.Rows, .Range("P5:P10000")).Copy Sheets("Innov").Range("B1")
    Intersect(.Rows, .Range("F5:F10000")).Copy Sheets("Innov").Range("C1")
    .AutoFilter
End With
With Sheets("Prod")
    .Range("A1:A" & .Range("B50000").End(xlUp).Row).Value = "Add"
    .SaveAs ThisWorkbook.Path & "\" & .Name & ".csv", xlCSV
End With
With Sheets("Innov")
    .Range("A1:A" & .Range("B50000").End(xlUp).Row).Value = "Add"
    .SaveAs ThisWorkbook.Path & "\" & .Name & ".csv", xlCSV
End With
End Sub

Arkadi's code is fine, though it throws a Runtime error 13 Type Mismatch error, as the conditions in the if statement inside the for loop fail as they are generated via formulas from another module in the same workbook. Hence, the values automatically change to #VALUE!

The same problems occurs even in k64's code.
How can this be fixed ?

I'd have to be a sample to be sure. My first idea, if my code is failing on the Autofiltering, then I would create a temporary values-only copy of the sheet first.

Hi Arkadi / K64,

Both codes work fine, Arkadi's code check all rows one by one, uses If conditions & copies them to appropriate sheets, whereas K64's code looks more simple & short and gets the work done through AutoFilter.

@K64 :

I've never used the Intersect function before, but wonder how it works. Can you brief me about it ?

Originally Posted by Saarang84

Hi Arkadi / K64,

Both codes work fine, Arkadi's code check all rows one by one, uses If conditions & copies them to appropriate sheets, whereas K64's code looks more simple & short and gets the work done through AutoFilter.

@K64 :

I've never used the Intersect function before, but wonder how it works. Can you brief me about it ?

Intersect returns a range composed of only those cells in common between the intersected ranges. So intersect(range("A:A"), range("1:1")) = range("A1")

Saarang, I don't quite follow... what condition on the sheet is causing the error to happen?

Originally Posted by Arkadi

Saarang, I don't quite follow... what condition on the sheet is causing the error to happen?

Hi Arkadi,

I've included comments in my workbook attached to my below post against your code. Refer to your module which I've renamed as "Export_Dumps_1".

I tried executing your module by setting breakpoints at specific parts of the code after integrating it with my existing code, but I get VBA run-time error '13' Type Mismatch error due to formulas getting auto-calculated and resulting in #VALUE! filled in the cell being compared against the values "#N/A" and "Prod Only" or "Innov Only".

Hi,

I've uploaded a sample workbook after removing insensitive data. There are formulas filled in the range (between columns L to W) which get auto-calculated when macro code gets executed on button click event.

I'm trying to link the code I'm seeking to build to the last button named Extract Dumps.

I tried running my code manually but of course that caused issues because the sheets didn't exist yet... then I made the sheets and ran it, but my macro calculates last row based on column A and your Raw_Data sheet has no values in Column A... So I changed it to column B, and it works... so I still can't see what is wrong with my macro?

Originally Posted by Arkadi

I tried running my code manually but of course that caused issues because the sheets didn't exist yet... then I made the sheets and ran it, but my macro calculates last row based on column A and your Raw_Data sheet has no values in Column A... So I changed it to column B, and it works... so I still can't see what is wrong with my macro?

Kindly comment the below lines in the Sub cmdExtDumps_Click() and then try executing the macro.

.Name = "Dump_Prod_" & Mid(Date, 3, 2) - 1 & MonthName(Left(Date, 1)) & Right(Year(Date), 2)
.Name = "Dump_Innov_" & Mid(Date, 3, 2) - 1 & MonthName(Left(Date, 1)) & Right(Year(Date), 2)
.Name = "Dump_Prod_" & Mid(Date, 3, 2) - 1 & MonthName(Left(Date, 1)) & Right(Year(Date), 2) & "_Post_WO"
.Name = "Dump_Innov_" & Mid(Date, 3, 2) - 1 & MonthName(Left(Date, 1)) & Right(Year(Date), 2) & "Post_WO"

The error I'm referring to occurs while executing the first if condition inside the For Loop in your module Export_Dumps_1

Ooooh it happens AFTER some of your other code... my macro is not causing this error.

I ran the Extract Dumps and did get the error you menttioned.... but not in my code, it happens well after you call my macro.

The error I see is on line: .Name = "Dump_Prod_" & Mid(Date, 3, 2) - 1 & MonthName(Left(Date, 1)) & Right(Year(Date), 2)

Originally Posted by Arkadi

I ran the Extract Dumps and did get the error you menttioned.... but not in my code, it happens well after you call my macro.

The error I see is on line: .Name = "Dump_Prod_" & Mid(Date, 3, 2) - 1 & MonthName(Left(Date, 1)) & Right(Year(Date), 2)

Kindly populate some random value in the range A5:A28 and re-run the module once again, to get to know the error I'm referring which is sourced from the formula-filled data in the range L to W.

Ok, I tried to put values in column A, then hit the button and Prod and Innov look just fine.... I get no error, and I don't see #Value in either raw data, innov, or prod.... so I still don't understand.

I even commented out where you call my macro, and you still get "#value" on raw_data... so my macro does not cause that at all.

Try this:

' K64's Module Code  - Uses AutoFilter method
Sub Export_Dumps_2()
Application.Calculation = xlCalculationManual 'Set calculation to manual to speed up processing and avoid recalculation errors
On Error Resume Next 'make sheets if they don't exist
Sheets.Add.Name = "Prod"
Sheets.Add.Name = "Innov"
On Error GoTo 0
With Sheets("Raw_Data").UsedRange
    .AutoFilter 12, "<>#N/A"
    .AutoFilter 23, "<>Innov Only"
    Sheets("Prod").Cells.Clear
    Intersect(.Rows, .Range("P5:P10000")).Copy Sheets("Prod").Range("B1")
    Intersect(.Rows, .Range("F5:F10000")).Copy Sheets("Prod").Range("C1")
    Sheets("Innov").Cells.Clear
    .AutoFilter 23, "<>Prod Only"
    Intersect(.Rows, .Range("P5:P10000")).Copy Sheets("Innov").Range("B1")
    Intersect(.Rows, .Range("F5:F10000")).Copy Sheets("Innov").Range("C1")
    .AutoFilter
End With
With Sheets("Prod")
    .Range("A1:A" & .Range("B50000").End(xlUp).Row).Value = "Add"
    .SaveAs ThisWorkbook.Path & "\" & .Name & ".csv", xlCSV
End With
With Sheets("Innov")
    .Range("A1:A" & .Range("B50000").End(xlUp).Row).Value = "Add"
    .SaveAs ThisWorkbook.Path & "\" & .Name & ".csv", xlCSV
End With
Application.Calculation = xlCalculationAutomatic
End Sub

You're weclome Saarang84, glad I could help! Thanks for the +rep

Out of curiosity Saarang, did k64's code fix it? or did you change something else? I'm very glad it worked out for you in the end