Hi!
I have around 20 odd files created everyday and in each file I just have to read Column BI having usernames and column BJ having dates and update the count of occurrences of username on that date.So in the below code I have usernames hard coded which is a drawback if usernames are added/removed I need to change the code every time.Also this report must on a daily basis attached is the tracker file.
Code
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)
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
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
Loop
myRange.Offset(2, 0) = num1
myRange.Offset(3, 0) = num2
myRange.Offset(4, 0) = num3
myRange.Offset(5, 0) = num4
End Sub
Display More