Cpying Unique entries to new spreadsheet

[gavster]

I'm trying to write a macro to use as an auto-update feature for a spreadsheet.

I currently use Data validation on an input cell to allow the user to select from a list of product types.

I'd like the update to affect this list, so new product types are always available to the user.

However, the list of product types is in another spreadsheet and contains numerous repetitions.

I've managed to get the following code together based on what I've used before and what I've found searching so far, but it seems to have a bug in it as it wont always work. I also need the original copying of the list to be done to either the new spreadsheet of a different page in the original spreadsheet, but every time I try this it causes an object error.

Sub Macro3()
'
' Macro3 Macro
' Macro recorded 05/12/2008 by Information Technology
'
    Workbooks.Open Filename:= _
        "T:\SST\CCD\Engineering\Backthin_data\Photolith\MASK_DETAILS.xls"
   Sheets("Mask List").Range("f4:f2000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("a1:a3"), CopyToRange:=Range("E1:E2000"), Unique:= _
        True
    Selection.Sort Key1:=Range("E1:e2000"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        Columns("E:E").Select
        Selection.Copy
      Windows("MASK_DETAILS.xls").Activate
    ActiveWindow.Close
    Windows("Dry_etcher_log_B.xls").Activate
    Sheets("Calc Sheet").Select
    Columns("M:M").Select
    ActiveSheet.Paste
 End Sub 

Could someone kindly point me in the correct direction.

Thank,
Gavin.

[royUK]

I can't test this without the workbooks, but try this

Option Explicit
Sub Macro3()
    Dim wbFrom As Workbook
    Dim CopyRange As Range
    Dim UniqueRange As Range
    Dim TargetCell As Range

    Set wbFrom = Workbooks.Open(Filename:="T:\SST\CCD\Engineering\Backthin_data\Photolith\MASK_DETAILS.xls")

    With wbFrom
        Set TargetCell = Cells(1, Columns.Count)
        Set CopyRange = Sheets("Mask List").Range(Cells(4, 5), Cells(Rows.Count, 5).End(xlUp))
        CopyRange.AdvancedFilter Action:=xlFilterCopy, _
                                 CopyToRange:=TargetCell, Unique:=True
        Set UniqueRange = Range(TargetCell, TargetCell.End(xlDown))
        UniqueRange.Sort Key1:=Range("E1:e2000"), Order1:=xlAscending, Header:=xlNo, _
                         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        UniqueRange.Copy Workbooks("Dry_etcher_log_B.xls").Sheets("Calc Sheet").Range("M1")
        .Close False
    End With
End Sub

[gavster]

Not sure this fully solves the problem.

I've attached the two files to help explain things, just removed all the extra code and unneeded pages.

The idea is that the data validation list in column D of the Dry Etch log is always uptodate.

The list should be a sorted version of column F from the Mask Details spreadsheet. It also needs to have the duplicates removed.

Thanks,
Gavin.

[royUK]

This seems to work fine for me.

Option Explicit
Sub Macro3()
    Dim wbFrom As Workbook
    Dim CopyRange As Range
    Dim UniqueRange As Range
    Dim TargetCell As Range

    Set wbFrom = Workbooks.Open(Filename:="T:\SST\CCD\Engineering\Backthin_data\Photolith\MASK_DETAILS.xls")

    With wbFrom
        Set TargetCell = .Sheets("Mask List").Cells(1, Columns.Count)
        Set CopyRange = .Sheets("Mask List").Range(Cells(2, 6), _
            Cells(Rows.Count, 6).End(xlUp))
        CopyRange.AdvancedFilter Action:=xlFilterCopy, _
                                 CopyToRange:=TargetCell, Unique:=True
        Set UniqueRange = Range(TargetCell, TargetCell.End(xlDown))
        UniqueRange.Sort Key1:=UniqueRange, Order1:=xlAscending, Header:=xlNo, _
                         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        UniqueRange.Copy Workbooks("Dry_etcher_log_c.xls").Sheets("Calc Sheet").Range("f1")
'        .Close False
    End With
End Sub

[gavster]

Sorry to be a pain Roy, but I still can't get this to work.

Could you post a working version based on the files I posted,
and then I can copy to the main spreadsheet and adjust the file links accordingly.

Thanks,
Gavin.

[royUK]

See if this is right

[gavster]

Roy,
I've copied the 2 files to my C drive, and tried to run the macro, but keep getting error 1004 if the Mask Details file is open.

If I haven't opened the mask details files separately, I get runtime error 9.

I'm off for the day now, so I'll think about it overnight.

Thanks for you assistance.

Gavin.

[royUK]

Post back tomorrow & I'll take another look.

The code works fine when I tested it but I had both books open

[gavster]

Roy,
Firstly let me apologise for the delay in replying. I've been a little busy.

I've retried the modified spreadsheet and it does indeed work fine. Thanks.

However, for some reason it wont work with the standard spreadsheet that contains all the data.

I've attached a copy so you can have a look to see if there is any difference, because I cant see it.

Thanks again,
Gavin.

[royUK]

The only difference that I can see is the data starts in different rows which would throw the code out. I'll have a closer look later but that could be the problem.

Try changing

  Set CopyRange = .Sheets("Mask List").Range(Cells(2, 6), _
                                                   Cells(Rows.Count, 6).End(xlUp))

to

  Set CopyRange = .Sheets("Mask List").Range(Cells(3, 6), _
                                                   Cells(Rows.Count, 6).End(xlUp))

[gavster]

Roy,
It looks like that has solved the problem.

My only issue now is that I do still get a few duplicates in the list on the second page.

They do not all appear in the dropdown list I'm using,
device type 73 appears at both ends. Could this be due to the length of the list?

If possible, could I filter the Mask Details sheet prior to copying the list, so only device types that are listed as Pad Expose in column H are copied across?

But thanks for your help so far.

Gavin.