Making existing macro dynamic-Tracking daily the count of usernames in multiple files based on a particular date.


So I have around 20 odd files that has two columns, column BI has username and BJ has dates,code here is in tracker file using countifs I am updating the tracker file the count of usernames on that day.Now I have hard coded the usernames and locating the date in tracker file with the help of user running the report. But is there any way to increase the dynamicity of code if users are added/removed.For now there are only 4 users.

 Sub Report()
Dim myRange As Range  'letting the user to locate a cell in tracker
Dim dates        As Variant  'storing located date
Set myRange = Application.InputBox(Prompt:="Locate a single cell containing date",
    Title:="Reporting", Type:=8)
    If myRange.Cells.Count = 1 Then
        dates = myRange.Value  
        MsgBox "Enter a single cell"
    End If
Dim user1, user2, user3, user4    As Variant  'usernames 
Dim cnt1, cnt2, cnt3, cnt4, num1, num2, num3, num4    As Long    ' counter for matching cell values in column BI and BJ
'hardcoding each usernames
Const DirName       As String = "C:\Users\Offices\"
Const Ext           As String = "*.xlsm"    'File extension
Dim NextFn          As String               ' name of the next file to process
Dim SrcWb           As Workbook
    NextFn = Dir(DirName & Ext)
     Do While NextFn <> ""
        Set SrcWb = Workbooks.Open(DirName & NextFn)
        cnt1 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Andrew", Range("BJ:BJ"), dates)
        num1 = num1 + cnt1

        cnt2 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Liss", Range("BJ:BJ"), dates)
        num2 = num2 + cnt2

        cnt3 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Carry", Range("BJ:BJ"), dates)
        num3 = num3 + cnt3

        cnt4 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Jafree", Range("BJ:BJ"), dates)
        num4 = num4 + cnt4
        NextFn = Dir
    myRange.Offset(2, 0) = num1
    myRange.Offset(3, 0) = num2
    myRange.Offset(4, 0) = num3
    myRange.Offset(5, 0) = num4
End Sub


Selected Answer

I love the way you now arranged the dates. Perfect! Now everything can be based on the dates, and here are the parameters used to count from the dates to any other cell in the sheet. (Find this dashboard at the top of the code in the code sheet of Sheet1.)

    NwsCapsCount = 2                ' rows for month captions (dates)
    NwsWorkerCount = 8              ' number of rows for worker names
                                    ' Caps + Workers = 1 group
    NwsFirstGroupRow = 2            ' row of first caption of first group
    NwsName = 1                     ' Columns:-

All the above settings match your current worksheet. But if you make changes in the future you will need to make adjustments only here, not anywhere else in the code. So, take a minute to understand the system. I think you're good at that.

The code works on double-click. The two cells B2:B3 have the same content and you can double-click either one to specify January 1 [2020]. All the other date cells, from B2:B3 to AF111:AF112, can also be double-clicked. The double-click will cause the program to run.

The program will first check if there are names in column A . If there are none it will copy names from the previous month. In January, there is no previous month. Therefore you have to enter the names manually for that month only. For the other months all names will be copied or none. This allows you to make changes to the list without fear of having them over-written. If a worker leaves you in July and two others join, add the new names in July and delete the redundant ones in August.

Having established that there is a list of names (currently maximum 8, blanks ignored) the program will call the function CountWork for each name, using the date that you double-clicked on. The program is a little slow, as I said earlier. This is because the files have to be opened. In my tests the speed got better toward the end of the list. Apparently Excel has some AI and improves performance when it gets the hang of what is being done.

When you use or even plan on changing the code it's as important to know what the code doesn't do, and why, as it is to know what it does do and how. Please read through the comments I have added. All the code is in the code module of Sheet1. It can't be moved to any other location because it reacts to the double-click event which can be captured only on that sheet.

Please remember to set the directory path in the CountWork function.



This is a great setup Variatus.Thank you so much.
Dr Liss (rep: 20) Jun 8, '20 at 3:11 am
I'm glad you like it. Beware, however, of the weakness inherent in this system. It's in the spelling of the names. Ideally, there should be only one source from which the Shopping Listings, the Report and the users' PCs draw. I managed to reduce the number of sources (of different spellings) within the Report to only one but the automated copying isn't foolproof. And for the other sources there is no control at all. Someone has a new boyfriend, decides to spell her name more fashonably, and then comes crying "the count doesn't work". Have a great day!
Variatus (rep: 4864) Jun 8, '20 at 3:29 am
Yes Understood. Thank you!
Dr Liss (rep: 20) Jun 8, '20 at 9:28 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login