Counting names

Copper Contributor

I am using a PC w/Windows 10 and MS 365.  I have a workbook with 12 sheets, one for each month of the year.  On each worksheet I have a list of all the people who have attended a meeting.  Each line contains their Last Name, First Name, & ID Number. (Along with some other information that is not required for a final count).  What I need is a single worksheet at the end of each year that tells me how many times each individual has attended a meeting along with their name and ID.  Each individual could attend one or more meetings in any given year.  There is no master personnel list to work from since some individuals are transient.  

6 Replies

@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

@Hans Vogelaar 

Hans,

Thanks for taking the time to give me a hand with this workbook.  I have never worked with macros, so I am struggling to fully understand what needs to be done.  I have made what I thought were the obvious changes to the macro, but when I run it I get nothing but an error message.  When I run the debug I get:

 

Sub Work_Party_Total()
'
' Work_Party_Total Macro
'

'
ChDir "C:\Users\dwojm\OneDrive\Documents"
ActiveWorkbook.SaveAs Filename:= _
"https://d.docs.live.net/0b2e42162b4a9117/Documents/Annual%20work%20party%20total.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.SmallScroll Down:=-45
Sheets("Sheet2").Select
End Sub

 

I have attached a sample of what I want to use.  I just used 2 months instead of all 12.  If you would be kind enough to take a look and point me in the right direction, I would be grateful.  When this is done I am going to take some time and try my hand a a few macros.  I am 78 years old and have always been pretty basic with my excel files.  I guess it is time for me to exercise my brain a little.

 

Thanks,

Denny Olson

@ftb1ss 

The code should be copied into the code module in the Visual Basic Editor, not into a worksheet.

It requires a few changes: in your monthly sheets, first name is in column C, last name in column B, and NCRR is column D. You need to change the constants FNCol etc. accordingly.

And the data in those sheets begin in row 4, not - as I had assumed - in row 2.

See the attached version.

You can run the macro ListNames in either of the following ways:

  • In Excel, press Alt+F8 to activate the Macros dialog. Select ListNames, then click Run. Or:
  • Press Alt+F11 to activate the Visual Basic Editor, click anywhere in the code of the ListNames macro, and press F5 to run it. Switch back to Excel to view the result.

The macro that you mention won't work; among other things, it refers to a non-existent sheet Sheet2.

@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.

image.png

@ftb1ss 

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

image.png

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.

Once again, thanks for the assist. I will sit down with it next week and see if I can get it to run. I am wrapped up with grand kid for the next few days. They say you can't teach an old dog new tricks. You can, it just takes a little longer.

Denny Olson