Filtering unique data & Remove duplicate rows & save unique record range in new book

[JOEYSCLEE]

Hi, there
Please kindly help to write the macro for removing duplicate rows when filtering unique data with the header Lot# and save the those data with different headers as below in new workbook.

Header of Raw Data = Header of Result

Lot # = Style
CC = Combo
Path = P Name

Enclosed the Raw Data file & Result file for your reference.Raw Data.xlsxResult from Raw Data.xls

Thanks in advance!!

[mike7952]

Give this a try

Sub abc()
 Dim arr, i As Long
 Dim x
 
 arr = Range("a1").CurrentRegion
 
 With CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If Not .exists(arr(i, 4)) Then
            x = Split(arr(i, 6), "-")
            .Item(arr(i, 4)) = _
            Array(arr(i, 4), arr(i, 5), arr(i, 6), x(0), Empty, arr(i, 7), arr(i, 8), x(1))
        End If
    Next
    i = 2
    Workbooks.Add
    Cells(1).Resize(, 8) = Array("Style", "Combo", "P Name", "VR #", "TOTAL", "Itin", "Mode", "DD")
    For Each x In .keys
        Cells(i, 1).Resize(, 8) = .Item(x)
        i = i + 1
    Next
 End With
End Sub

[p45cal]

Try clicking the button on the sheet in the attached, then navigate to the version of the file you attached in your last message on your computer and click OK.
It'll probably need a tweak or two if your actual files are significantly different from your sample Raw Data.xlsx file.

[JOEYSCLEE]

Give this a try

Sub abc()
 Dim arr, i As Long
 Dim x
 
 arr = Range("a1").CurrentRegion
 
 With CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If Not .exists(arr(i, 4)) Then
            x = Split(arr(i, 6), "-")
            .Item(arr(i, 4)) = _
            Array(arr(i, 4), arr(i, 5), arr(i, 6), x(0), Empty, arr(i, 7), arr(i, 8), x(1))
        End If
    Next
    i = 2
    Workbooks.Add
    Cells(1).Resize(, 8) = Array("Style", "Combo", "P Name", "VR #", "TOTAL", "Itin", "Mode", "DD")
    For Each x In .keys
        Cells(i, 1).Resize(, 8) = .Item(x)
        i = i + 1
    Next
 End With
End Sub

Hello,Mike
Thank you for your quick respond! The macro works as my result
But would you please modify your reply...If there is 1 more column at the end of the result tab with the Header - Default (Y/N) & the content of this column is Y.
Enclosed the attachment for reviewing.

[JOEYSCLEE]

Try clicking the button on the sheet in the attached, then navigate to the version of the file you attached in your last message on your computer and click OK.
It'll probably need a tweak or two if your actual files are significantly different from your sample Raw Data.xlsx file.

Hello,p45cal
Thank you for your consideration for filtering the original data of Plant in Raw Data file. It is great for me for another option.

In fact, I have the different files with the different tab name. Hence, I try to put the your code for those files. Unfortunately, there is the error with the line - .Refresh BackgroundQuery:=False

So, would you please advise how can I modify your code? For instance, I have the filename = 2017 ACC with the Tab name 459GEF and the headers are same as mentioned before.

Thanks in advance for your consideration!!

[mike7952]

I guessing, you just want to add Y as the value to the last column

Sub abc()
    Dim arr, i As Long
    Dim x
     
    arr = Range("a1").CurrentRegion
     
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(arr)
            If Not .exists(arr(i, 4)) Then
                x = Split(arr(i, 6), "-")
                .Item(arr(i, 4)) = _
                Array(arr(i, 4), arr(i, 5), arr(i, 6), x(0), Empty, arr(i, 7), arr(i, 8), x(1), "Y")
            End If
        Next
        i = 2
        Workbooks.Add
        Cells(1).Resize(, 9) = Array("Style", "Combo", "P Name", "VR #", "TOTAL", "Itin", "Mode", "DD", "Default(Y/N)")
        For Each x In .keys
            Cells(i, 1).Resize(, 9) = .Item(x)
            i = i + 1
        Next
    End With
End Sub

[p45cal]

would you please advise how can I modify your code? For instance, I have the filename = 2017 ACC with the Tab name 459GEF and the headers are same as mentioned before.
Thanks in advance for your consideration!

You've probably seen the SQL needs adjusting to match the sheet name. This will need to be automated.
Whether this is worth doing or not depends on how big your task is; if it's on a daily basis it may be worth doing. Only once every 6 months? Use Mike7952's solution. 50 files at once? We can probably process 50 files in one go in less than a minute by tweaking my offering.

So… lots of questions:
Is there always only one sheet per .xlsx data file?
Is the table always at cell A1?
Does the data come to you in Excel format? (If it comes to you as a .csv file, your computer may be opening it by default as an Excel file (and identifying it as such) but it isn't really and it could be interrogated directly.)
Does it comes in any other format? (It may be easier to get the data directly.)

Perhaps attach a sample or two of the real data files here (if sensitive info is in them, ask me for a personal email address via Private Messaging here so that you can send them privately).

BTW, the adjustment needed for your 459GEF sheet would probably be:
.CommandText = "SELECT DISTINCT `Lot #`, CC, Path, Plant, Type FROM `459GEF$`"
replacing the existing similar line.
You need of course to select the file with that sheet name in (2017 ACC.xlsx?) when the macro runs.
Note that it's considerably shorter than my original (recorded) version of that line.

[JOEYSCLEE]

I guessing, you just want to add Y as the value to the last column

Mike...You are correct. It's the right value what I want to add in the last column. Thanks a lot!

Sub abc()
    Dim arr, i As Long
    Dim x
     
    arr = Range("a1").CurrentRegion
     
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(arr)
            If Not .exists(arr(i, 4)) Then
                x = Split(arr(i, 6), "-")
                .Item(arr(i, 4)) = _
                Array(arr(i, 4), arr(i, 5), arr(i, 6), x(0), Empty, arr(i, 7), arr(i, 8), x(1), "Y")
            End If
        Next
        i = 2
        Workbooks.Add
        Cells(1).Resize(, 9) = Array("Style", "Combo", "P Name", "VR #", "TOTAL", "Itin", "Mode", "DD", "Default(Y/N)")
        For Each x In .keys
            Cells(i, 1).Resize(, 9) = .Item(x)
            i = i + 1
        Next
    End With
End Sub

[JOEYSCLEE]

You've probably seen the SQL needs adjusting to match the sheet name. This will need to be automated.
Whether this is worth doing or not depends on how big your task is; if it's on a daily basis it may be worth doing. Only once every 6 months? Use Mike7952's solution. 50 files at once? We can probably process 50 files in one go in less than a minute by tweaking my offering.
JL : Thank you for below briefly explanation!!
Actually, the files are related for the order creations. The Original Raw Data file got the column from A to EH with the different color in the Header cell so that it was modified for posting the question.

So… lots of questions:
Is there always only one sheet per .xlsx data file? JL : Yes. There is always 1 sheet per .xlsx data file.

Is the table always at cell A1? JL : The Header of those files is always at cell A1 and the Header is highlighted with different colors. In general, there are no value in 1st & 2nd column and only has the Header.

Does the data come to you in Excel format? (If it comes to you as a .csv file, your computer may be opening it by default as an Excel file (and identifying it as such) but it isn't really and it could be interrogated directly.)
Does it comes in any other format? (It may be easier to get the data directly.
JL : Those files always come in Excel format.

Perhaps attach a sample or two of the real data files here (if sensitive info is in them, ask me for a personal email address via Private Messaging here so that you can send them privately.
JL : I'm sorry that I don't have the real data files right now.

BTW, the adjustment needed for your 459GEF sheet would probably be:
.CommandText = "SELECT DISTINCT `Lot #`, CC, Path, Plant, Type FROM `459GEF$`"
replacing the existing similar line.
You need of course to select the file with that sheet name in (2017 ACC.xlsx?) when the macro runs.
Note that it's considerably shorter than my original (recorded) version of that line.

JL : I'll try the above advice when I'm in the office next Monday. Again, thank you for your briefly explanation to let me know the problem.

[p45cal]

The headers being always in row 1 and there being only one sheet per Excel file is good news.
The order in which the headers appear in the source doesn't matter a jot, nor does it matter if there are many columns of data, as long as the ones you want are each always spelt the same, colour doesn't matter either.

Which version of Excel are you using (you supplied a .xls file which implies pre-Excel 2007)?
How often are you going to have to do this, and how much time is it currently taking?

[JOEYSCLEE]

The headers being always in row 1 and there being only one sheet per Excel file is good news.
The order in which the headers appear in the source doesn't matter a jot, nor does it matter if there are many columns of data, as long as the ones you want are each always spelt the same, colour doesn't matter either.

Which version of Excel are you using (you supplied a .xls file which implies pre-Excel 2007)?
How often are you going to have to do this, and how much time is it currently taking?

Finally, I change the File name and tab sheet with "Raw Data" . It's workable. Thank you for your help!!

[p45cal]

If you were to answer my questions maybe I could do something to help.

[JOEYSCLEE]

If you were to answer my questions maybe I could do something to help.

JL : Thank you for your kindness!!

Which version of Excel are you using (you supplied a .xls file which implies pre-Excel 2007)?
JL : I'm using Excel 2010 with ( *.xlsx) format in general.

How often are you going to have to do this, and how much time is it currently taking?
JL : 5 files or less every day. (not many files as you stated before. So, I changed the filenames & Tab names as per above mention)

[p45cal]

Try the attached.
No need to rename files or tabs.
New workbooks are not saved anywhere, just left open.
If you need them named and saved somewhere specific, come back.

[JOEYSCLEE]

Try the attached.
No need to rename files or tabs.
New workbooks are not saved anywhere, just left open.
If you need them named and saved somewhere specific, come back.

Work perfectly!! Again, thanks for your kindness for reviewing my issue and help to solve it out!!!