Hi Guys,

i wrote macro which is checking if something new was added/removed/updated to table column and refreshing pivot table in separate tab in order to get unique value.
But it is a lot of code and i do not know - maybe there is another solution which i can use and will be easier and faster?

Can anybody had similar issue? 

Option Explicit

Const TableName As String = "Vn_Input_Tier_Storage"

Private Sub Worksheet_Activate()
    
    Dim dic As Object

    If dic Is Nothing Then
        Set dic = AddDvTables
    End If
    
    Call myTable(TableName)

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myTableList As ListObject
    Set myTableList = myTable(TableName)
    Dim strCurrentColName As String
    Dim dic As Object
    Dim ArrayHeader As Variant
    Dim i As Long
    Dim dicRefresh As Object
    Dim keyik As Variant

    If dic Is Nothing Then
        Set dic = AddDvTables
    End If

On Error GoTo NextStep
    If Not Intersect(Target, myTableList.DataBodyRange) Is Nothing Or Not Intersect(Target.Rows.Offset(-1, 0), myTableList.DataBodyRange) Is Nothing Then
    Set dicRefresh = CreateObject("scripting.dictionary")
       If Target.Columns.Count > 1 Then
           ArrayHeader = myTableList.HeaderRowRange
           For i = 1 To UBound(ArrayHeader, 2)
                If dic.exists(ArrayHeader(1, i) & "-" & TableName) Then
                    dicRefresh.Add ArrayHeader(1, i) & "-" & TableName, 1
                End If
           Next i
               GoTo NextStep
       Else
            If dic.exists(Cells(Target.ListObject.Range.Row, Target.Column).Value & "-" & TableName) Then
                    dicRefresh.Add Cells(Target.ListObject.Range.Row, Target.Column).Value & "-" & TableName, 1
            End If
                GoTo NextStep
       End If
    End If
    
NextStep:
    
    If dicRefresh Is Nothing Then
       GoTo Endik
    End If
    For Each keyik In dicRefresh
            With HiddenDV
                Dim pt As PivotTable
                Set pt = HiddenDV.PivotTables(keyik)
                pt.RefreshTable
                Set pt = Nothing
            End With
    Next
Endik:
Set dicRefresh = Nothing

End Sub

Static Function myTable(Optional strVar As String) As Object

Static SourceTable As ListObject

If SourceTable Is Nothing Then
 Set SourceTable = Me.ListObjects(strVar)
End If

    Set myTable = SourceTable

End Function

Static Function AddDvTables() As Object
    Static AddDvTablesDiffName As Object
    Dim i As Byte
    Dim oRow As ListRow

    If AddDvTablesDiffName Is Nothing Then
        Set AddDvTablesDiffName = CreateObject("Scripting.Dictionary")
        Dim lst As ListObject
        Set lst = HiddenDV.ListObjects("t_HiddenSourceDV")
        
    For Each oRow In lst.ListRows
      i = i + 1
      
      If Not AddDvTablesDiffName.exists(CStr(oRow.Range(1, 1))) Then
           AddDvTablesDiffName.Add CStr(oRow.Range(1, 1)), oRow.Range.Cells(1, 2).Resize(, 3)
      Else
            MsgBox "You cannot have duplicates in DV Lists sheet"
      End If
    Next oRow
        
    End If

Set AddDvTables = AddDvTablesDiffName

End Function
Screenshot_21.png

Code is:
1. checking if something was added/deleted/updated in table
2. if yes looping through table header and checking the match
3. If it is a match - refresh pivot table in hidden worksheet.
4. As result i have a list of uniques from specific column

In attachment example workbook.

All sugesstion are welcome.

Best Wishes,
Jacek