Counting names

ftb1ss 

I was puzzled by the fact that I got different results from a worksheet formula.

Turns out I placed my trust in firstName/lastName combinations rather than the NCRR number.  Perhaps Paul Hollandsworth is known as Curtis Lenderman to his friends?  My formula was

= LET(
  distinct, UNIQUE(VSTACK(March,April)),
  first,  INDEX(distinct,,2),
  last, INDEX(distinct,,1),
  Mch, COUNTIFS(March[Last], last, March[First], first),
  Apr, COUNTIFS(April[Last], last, April[First], first),
  Mch+Apr)

I would need to write a Lambda function to replace Charles Williams's VSTACK for the formula to post to other machines and the method does not scale well to incorporate additional tables.

ftb1ss As variant that could be done by Power Query.

- name range for each month

- add function which takes the month and clean the data

(month as text) =>
let
    Source = Excel.CurrentWorkbook(){[Name=month]}[Content],
    #"Promoted Headers" = Table.PromoteHeaders(Source, [PromoteAllScalars=true]),
    #"Removed Other Columns" = Table.SelectColumns(#"Promoted Headers",{"Last", "First", "NCRR"}),
    #"Filtered Rows" = Table.SelectRows(#"Removed Other Columns", each ([Last] <> null))
in
    #"Filtered Rows"

- combine months

let
    Source = Table.Combine(
     {
        fnGetMonth("Mar"),
        fnGetMonth("Apr")
     }
    )
in
    Source

- count by NCPR

let
    Source = #"Combine months",
    #"Grouped Rows" = Table.Group(
        Source,
        {"NCRR"},
        {{"Count", each Table.RowCount(_), Int64.Type}}
    )
in
    #"Grouped Rows"

in general that could be all, but names are spelled differently in different months, thus we map Names on NCPR

- takes names and remove duplicated NCPR

let
    Source = #"Combine months",
    #"Removed Duplicates" = Table.Distinct(Source, {"NCRR"})
in
    #"Removed Duplicates"

- merge names with counts using NCPR as the key

let
    Source = Table.NestedJoin(
        Names, {"NCRR"},
        Counts, {"NCRR"},
        "Counts", JoinKind.LeftOuter
    ),
    #"Expanded Counts" = Table.ExpandTableColumn(
        Source, "Counts",
        {"Count"}, {"Count"}
    )
in
    #"Expanded Counts"

Now that's all.

ftb1ss 

Here is a macro that you can use. Change the constants at the beginning to match your setup.

The macro will create a summary sheet if it doesn't exist, otherwise it will overwrite its contents.

Sub ListNames()
    ' Change the constants as needed
    Const strSummary = "Summary" ' Name of the summary sheet
    Const FNCol = "A" ' First Name column
    Const LNCol = "B" ' Last Name column
    Const IDCol = "C" ' ID column
    Dim dctFN As Object
    Dim dctLN As Object
    Dim dctID As Object
    Dim wsh As Worksheet
    Dim wss As Worksheet
    Dim r As Long
    Dim m As Long
    Dim varID As Variant
    Application.ScreenUpdating = False
    Set dctFN = CreateObject(Class:="Scripting.Dictionary")
    Set dctLN = CreateObject(Class:="Scripting.Dictionary")
    Set dctID = CreateObject(Class:="Scripting.Dictionary")
    On Error Resume Next
    Set wss = Worksheets(strSummary)
    On Error GoTo 0
    If wss Is Nothing Then
        Set wss = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        wss.Name = strSummary
    Else
        wss.Cells.Clear
    End If
    wss.Range("A1:D1").Value = Array("First Name", "Last Name", "ID", "Count")
    For Each wsh In Worksheets
        If wsh.Name <> strSummary Then
            m = wsh.Range(IDCol & wsh.Rows.Count).End(xlUp).Row
            For r = 2 To m
                varID = wsh.Range(IDCol & r).Value
                If dctID.Exists(varID) Then
                    dctID(varID) = dctID(varID) + 1
                Else
                    dctID.Add Key:=varID, Item:=1
                    dctFN.Add Key:=varID, Item:=wsh.Range(FNCol & r).Value
                    dctLN.Add Key:=varID, Item:=wsh.Range(LNCol & r).Value
                End If
            Next r
        End If
    Next wsh
    wss.Range("A2").Resize(dctID.Count) = Application.Transpose(dctFN.Items)
    wss.Range("B2").Resize(dctID.Count) = Application.Transpose(dctLN.Items)
    wss.Range("C2").Resize(dctID.Count) = Application.Transpose(dctID.Keys)
    wss.Range("D2").Resize(dctID.Count) = Application.Transpose(dctID.Items)
    wss.Range("A1:D1").EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub