Apr 02 2021 10:54 AM
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.
Apr 02 2021 11:44 AM
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
Apr 04 2021 08:27 AM
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
Apr 04 2021 08:42 AM
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:
The macro that you mention won't work; among other things, it refers to a non-existent sheet Sheet2.
Apr 04 2021 09:42 AM
@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.
Apr 04 2021 12:57 PM
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.
Apr 08 2021 02:19 PM