VBA:copy rows based on criteria to a new sheet/file.

[lakersbg]

Dear Excel pros,
Unfortunately I don't know much about the VBA language so I'll appreciate it if you could help me on the following macro:
Each month I get two files with data which I have to reconcile (find for each customer account (let's say each unique value in column A) the rows that are missing in one of the two files. So, I want to do a macro which would help me, once I've put the data into one sheet and sorted on Column A, to copy the rows containing each unique value in A (each customer) into a new sheet/file. After that I can easily delete the duplicate rows and see what is missing from one of the files.
I found a macro that more or less suits me, but I need to make it repeat itself for each unique value in Column A (or from a list of values if it will be easier).
Here is the macros that I found, you can modify it to suite my purpose. Big thank you in advance!
Best Regards,
Lakersbg

Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is a 0 in column N
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String

'Get the current file's name
CurrentFileName = ActiveWorkbook.Name
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS3000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = Range("Sheet2!A1").Value
'NOTE - this filter is on column A (field:=1), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=1, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
Workbooks.Add Template:="Workbook"
'Get this file's name
NewFileName = ActiveWorkbook.Name
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
Workbooks(CurrentFileName).Activate
'Clear the autofilter
Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[tcfreer]

Hi Alpha

Back again just looking to modify the code we have here for another purpose as it fits it

I'm looking to use the code to select a specified number that is in column D on the Data sheet for this

I then want bring that cell + the contents of Columns A, G, B, E - In that order into another sheet, for each instance.

Is that do able with this code?

Regard's

TC

 

[KCK01]

Hi AlphaFrog, I hope you are still monitoring this epic thread!
I am using a version of your brilliant code from page three ( with minor changes as needed). The only problem I am having is when the filtered column has no data in it but the rest of the row does. It errors out with error code 1004 at line "DestWbk.Sheets(1).Name = Cl.Value".

I hope you can help me with this.

Sub AA_Extract_All_Data_To_New_Workbook()
'MrExcel Forum
    Dim DestWbk As Workbook
    Dim DataRng As Range
    Dim Cl As Range
    Dim Pth As String
    Dim UsdRws As Long
    Dim WinCol As Long
    
Application.ScreenUpdating = True

    Pth = ActiveWorkbook.FullName
    Pth = Left(Pth, InStr(Pth, ".") - 1)
    
    UsdRws = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    WinCol = Rows(1).Find("Salesperson", , xlValues, xlWhole, , , False, , False).Column
    Set DataRng = ActiveSheet.UsedRange
    With CreateObject("scripting.dictionary")
        For Each Cl In Range(Cells(2, WinCol), Cells(UsdRws, WinCol))
            If Not .exists(Cl.Value) And Not IsError(Cl.Value) Then
                .Add Cl.Value, Nothing
                Set DestWbk = Workbooks.Add(xlWBATWorksheet)
                DataRng.AutoFilter WinCol, Cl.Value
                DataRng.SpecialCells(xlVisible).Copy DestWbk.Sheets(1).Range("A1")
                DestWbk.Sheets(1).Name = Cl.Value
                DestWbk.SaveAs Pth & "-" & Cl.Value, 51
                DestWbk.Close , False
            End If
        Next Cl
    End With
    DataRng.AutoFilter
    
Application.ScreenUpdating = True

End Sub

 

[AlphaFrog]

That line just renames the sheet tab. If the cell is blank then it can't name the sheet. You could just delete that line and keep the default sheet name.

 

[KCK01]

Thank you. That did the trick!

 

[tcfreer]

Hi Alpha

Another Question on averation of this code

Sub Extract_All_Data_To_New_Workbook()

'this macro assumes that your first row of data is a header row.
'will copy all filtered rows from one worksheet, to another blank workbook
'each unique filtered value will be copied to it's own workbook

'Variables used by the macro
Dim wbDest As Workbook
Dim rngFilter As Range, rngUniques As Range
Dim cell As Range
Dim shSource As Worksheet
Dim v As Variant, i As Long

Set shSource = ThisWorkbook.Sheets("Payment_export") 'Source worksheet

Application.ScreenUpdating = False

' Set the filter range (from E1 to the last used cell in column E)
'(Note: you can change this to meet your requirements)
v = shSource.Range("A2", shSource.Range("A" & Rows.Count).End(xlUp))
For i = 1 To UBound(v, 1)
v(i, 1) = Left(v(i, 1), 25)
Next
Range("A2").Resize(UBound(v, 1)).Value = v
Set rngFilter = shSource.Range("A1", shSource.Range("A" & Rows.Count).End(xlUp))

' Filter column E to show only one of each item (uniques) in column E
rngFilter.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

' Set a variable to the Unique values
Set rngUniques = shSource.Range("A2", shSource.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

' Clear the filter
If shSource.FilterMode Then shSource.ShowAllData

' Filter, Copy, and Paste each unique to its own new workbook
For Each cell In rngUniques

' Create a new workbook for each unique value
Set wbDest = Workbooks.Add(xlWBATWorksheet)

'NOTE - this filter is on column E (field:=5), to change
'to a different column you need to change the field number
rngFilter.AutoFilter Field:=1, Criteria1:=cell.Value

' Copy and paste the filtered data to its new workbook
rngFilter.EntireRow.Columns("A:AM").Copy
With wbDest.Sheets(1).Range("A1")
.PasteSpecial xlPasteColumnWidths 'Paste column widths
.PasteSpecial xlPasteValuesAndNumberFormats 'Paste values
End With
Application.CutCopyMode = True

' Name the destination sheet
wbDest.Sheets(1).Name = cell.Value

'Save the destination workbook and close
wbDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & _
cell.Value & " " & Format(Date, "ddmmyy")

wbDest.Close False 'Close the new workbook

Next cell

If shSource.FilterMode Then shSource.ShowAllData
shSource.AutoFilterMode = False
Application.ScreenUpdating = True

MsgBox "Completed"

End Sub

So my values in A are the ones I need to filter by, and then export to a new worksheet.

I also need to select 0 in column a and the delete all of those before doing the filter and then putting the good data into its own sheet

I then for a selected variable from column a need to output a workbook that has all the data, but split by column b into different tabs?

 

[rjmdc]

hi
is this still an active post?
it is brilliant but i cant seem to make the code do what i need.
i messed up so many workbooks. Thank G-D i made copies to try on