Excel VBA Function to count all distinct values across multiple tables (same column name)

module1.bas

Option Explicit

Function CountUnique(TableNames As Range, ColumnName As String) As Long
    Dim TableName
    Dim TempRange As Range
    Dim Rng As Range
    Dim List As Object
    
    ' Iterate through every range and push cell values to dictionary keys, and count the keys
    With CreateObject("Scripting.Dictionary")
        For Each TableName In TableNames.Cells
            Set TempRange = GetTableRange(TableName.Value, ColumnName)
            If Not TempRange Is Nothing Then
                For Each Rng In TempRange
                    If Rng.Value <> "" And Not .Exists(Rng.Value) Then .Add Rng.Value, Nothing
                Next
            End If
        Next
        CountUnique = .Count
    End With
End Function

' Search each sheet for table with given name and fetch the range with given column name
Private Function GetTableRange(Name As String, ColumnName As String) As Range
    Dim Sheet As Worksheet
    For Each Sheet In ThisWorkbook.Worksheets
        On Error Resume Next
        Set GetTableRange = Sheet.ListObjects(Name).ListColumns(ColumnName).DataBodyRange
        If Not GetTableRange Is Nothing Then Exit Function
    Next
    GetTableRange = Nothing
End Function