Move Data From one work book to another with Criteria

[nr6281]

Hi,

I am stuck in one of my projects and I have no clue to work around this. I have a report with 50000 rows of data with 21 columns.

I want to move data based on certain code words I created in column D For EG: RS, RA, PE, RO and So on.

The data should be moved from Data Raw file to Data sorted File but based on the Code I have created sheets so which means RS from DATA raw should go to RS sheet in DATA sorted, the same should happen for all the other codes.

Any help appreciated i tried tweaking a macro for one of project but due to the large data the file hangs the whole day.


EDIT:
Advance filter wont work because I want to move data to a different workbook named Data Sorted from Data Raw.

 

[nr6281]

Anybody?

 

[JLGWhiz]

I am not sure I understand everything, but here is a try at it. This assumes both workbooks will be open at run time. You will also need to edit the workbook names since they were inconsistent in the post. I just used proper case on them.

Sub t()
Dim wb1 As Workbook, wb2 As Workbook, sh As Worksheet, lr As Long
Set wb1 = Workbooks("Data Raw.xlsx") 'Edit wb name
Set wb2 = Workbooks("Data Sorted.xlsx") 'Edit wb name
Set sh = wb1.Sheets(1)
lr = sh.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
sh.Range("D1", sh.Cells(Rows.Count, 4).End(xlUp)).AdvancedFilter xlFilterCopy, , sh.Cells(lr + 2, 1), True
    For Each c In sh.Cells(lr + 2, 1).CurrentRegion.Offset(1)
        If c <> "" Then
            sh.Range("A1:A" & lr).EntireRow.AutoFilter 4, c.Value
            sh.Range("A2:A" & lr).EntireRow.SpecialCells(xlCellTypeVisible).Copy _
            wb2.Sheets(c.Value).Cells(Rows.Count, 1).End(xlUp)(2)
        End If
        sh.AutoFilterMode = False
    Next
sh.Cells(lr + 2, 1).CurrentRegion.ClearContents
End Sub

Also be sure the file extensions are correct for each workbook.

 

[nr6281]

Hi,

Sorry that the query is not clear

I have attached a sample template now.

Data Raw - This file contains all the raw data (will changed each day). Now in column D Status Code these are constant to the data (Please see codes in sheet name codes these are all the codes)
Data Sorted - All the data from raw sheet should be moved to this file based on the code (all the sheet are named after the code)

The above is what I am trying to achieve.

Thanks in advance.

 

[nr6281]

I am not able to attach a file here,

Sample
[TABLE="width: 2483"]
<colgroup><col><col><col><col><col span="2"><col span="3"><col><col><col span="2"><col><col span="7"></colgroup><tbody>[TR]
[TD]Order ID[/TD]
[TD]Parent[/TD]
[TD]Status[/TD]
[TD]Status Code[/TD]
[TD]Status Date[/TD]
[TD]Order Date[/TD]
[TD]Consideration Code[/TD]
[TD]Element Score[/TD]
[TD]Component[/TD]
[TD]Product Family[/TD]
[TD]Subtype[/TD]
[TD]Element Number[/TD]
[TD]PROM Suborder Number[/TD]
[TD]Records ETA[/TD]
[TD]Source State[/TD]
[TD]Report Code[/TD]
[TD]Package[/TD]
[TD]Candidate[/TD]
[TD]Account Name[/TD]
[TD]Special Instruction[/TD]
[TD]Case Status[/TD]
[/TR]
[TR]
[TD]123456[/TD]
[TD]NAN[/TD]
[TD][/TD]
[TD]RS[/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
</tbody>[/TABLE]

Fixed codes

[TABLE="width: 85"]
<colgroup><col></colgroup><tbody>[TR]
[TD]DU[/TD]
[/TR]
[TR]
[TD]EU[/TD]
[/TR]
[TR]
[TD]PE[/TD]
[/TR]
[TR]
[TD]PL[/TD]
[/TR]
[TR]
[TD]RE[/TD]
[/TR]
[TR]
[TD]RF[/TD]
[/TR]
[TR]
[TD]RH[/TD]
[/TR]
[TR]
[TD]RI[/TD]
[/TR]
[TR]
[TD]RL[/TD]
[/TR]
[TR]
[TD]RZ[/TD]
[/TR]
[TR]
[TD]T1[/TD]
[/TR]
[TR]
[TD]T3[/TD]
[/TR]
[TR]
[TD]T4 and T8[/TD]
[/TR]
[TR]
[TD]T5[/TD]
[/TR]
[TR]
[TD]T6 and T2[/TD]
[/TR]
[TR]
[TD]T7[/TD]
[/TR]
[TR]
[TD]T7/II/T8[/TD]
[/TR]
[TR]
[TD]T7[/TD]
[/TR]
[TR]
[TD]CC[/TD]
[/TR]
[TR]
[TD]XC and XD


All the above codes have a sheet in Data Sorter XLSM[/TD]
[/TR]
</tbody>[/TABLE]

 

[JLGWhiz]

Thanks for the additional information, but it does not change anything in the code in post #3 . Did you try the code? What were the results? If you received error an error message, what was it and what line of code was highlighted when the 'Debug' button was clicked?

Also, be sure you have edited the workbook names before running the code. If the workbook names are not correct, then the code fails.

 

[nr6281]

hi I am getting an error on these two.

sh.Range("A2:A" & lr).EntireRow.SpecialCells(xlCellTypeVisible).Copy _
wb2.Sheets(c.Value).Cells(Rows.Count, 1).End(xlUp)(2)

The files are attached here.
https://www.excelforum.com/excel-pr...one-work-book-based-criteria.html#post5145332