VBA code to automatically extract unique values from list with named ranges

[pokopikos]

Hi all,

I am facing a problem with regards to the spreadsheet model I am building at the moment, and since i am rather new Excel user, it seems impossible to solve at the moment.

I have a large bunch of data (cells A8:U2000+), with the + meaning that they are dynamic (one week there might be 1500 rows, the next 1650 etc). The "ID" of the entries is the spare part code, which is in column D. It should be noted that there are many duplicate entries (meaning same part, but with different characteristics; the other columns) I want to build a list of unique entries in cells AF8:AF(X), where X is the row indicating the total number of unique entries. Say the first week there are 30 unique parts, week two 25 unique parts and so on.

In the adjacent columns, AG-AX I will calculate some variables from the values in columns A-U (using sumifs and other operations. There is a catch. Since I have to build many charts from these values, and the number of entries (Unique parts) vary greatly by week (any value between 10-50), I used the named ranges for those values in order to automatically update the charts, like the following (the 600 is just to be sure we get all values):

=OFFSET('Line 53'!$AU$8,0,0,COUNTA('Line 53'!$AU$8:$AU$600),1)

How can I write a code to automatically extract the NEW for each week unique values from the 2000 entries on the left (A-U) to the right entries (from AF and on), without deleting the named ranges?

I tried recording one, like the following but it doesn't work:

Sub Extract_unique()'
' delete Macro
'


      With Application
        .ScreenUpdating = False
        .EnableEvents = False
      End With


    Sheets("Line").Activate
    Range("ID_53").Select
    Range("AF7").Activate
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("AH20").Select
    
    Dim LR As Long
      LR = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).row
        Range("D7:D" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AF7"), Unique:=True
        Range("AF7").Value = "Unique Parts"
        
     Sheets("Line").Activate
   Range("ID_53").Select
        Selection.BorderAround Weight:=xlMedium
        Range("ID_53").Interior.ColorIndex = 24
    
    Range("Unique_53").Select
        Selection.BorderAround Weight:=xlMedium
        Range("Unique_53").Interior.ColorIndex = 24
    
    
End Sub

I hope I made myself understood!
Please help me out with this!!