Vba Loop through all tabs and count

[ffionnah]

Hi all!
I am semi familiar with macros but I’m having difficulties knowing where to start for a request. The purpose is to loop through all tabs within a workbook and count the rows (Count count text via column “B” that will not be empty unless the data comes to an end) based on a date entered into column “AB”. I would like for this to either display in a message box or could be consolidated to a new sheet.

such as:
5/26/2020 - 48
5/27/2020 - 120
5/28/2020 - 87

Is this possible? The counting/ sum per date, across all tabs is what I am stumbling with most.

Thank you for all of your insights!

 

[DanteAmor]

Put the dates in column AB on sheet1. As it's shown in the following.
The results will be in column AC.

varios 28may2020.xlsm
	AB	AC
1
2	26/05/2020	3
3	27/05/2020	2
4	28/05/2020	1
Sheet1

Sub CountDates()
  Dim sh As Worksheet, c As Range, nSum As Double
  For Each sh In Sheets
    For Each c In Sheets("Sheet1").Range("AB2", Sheets("Sheet1").Range("AB" & Rows.Count).End(3))
      nSum = WorksheetFunction.CountIf(sh.Range("B2", sh.Range("B" & Rows.Count).End(3)), c)
      c.Offset(, 1).Value = c.Offset(, 1).Value + nSum
    Next
  Next
End Sub

 

[ffionnah]

Good morning,
Thank you for the reply! I tried your code and, unfortunately, it didn't count the rows that have a date in column "AB".
I added Sheets.Add and ActiveSheet.Name = "Counts" and a sort for each tab because there may be rows that are skipped to your code and it produces two "0" in column AC of the "Counts" sheet.

Sub CountDates()
  Dim sh As Worksheet, c As Range, nSum As Double
  Sheets.Add
  ActiveSheet.Name = "Audit Counts"
  
  
    ActiveSheet.Range("a1:cw1").Select
   Selection.Copy
   On Error Resume Next
   Application.ScreenUpdating = False
   
  For Each sh In Sheets
      sh.Columns("A:cw").Sort Key1:=sh.Columns("AB"), Order1:=xlDescending
   Next sh

   ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteAll
   Application.ScreenUpdating = True
    
   For Each sh In Sheets
   
    For Each c In Sheets("Audit Counts").Range("AB2", Sheets("Audit Counts").Range("AB" & Rows.Count).End(3))
      nSum = WorksheetFunction.CountIf(sh.Range("B2", sh.Range("B" & Rows.Count).End(3)), c)
      c.Offset(, 1).Value = c.Offset(, 1).Value + nSum
    Next
  Next
End Sub

sample data:

(skipping columns just to display data)

Column B will always have data entered. Column AB is what I need for the counts to be grouped by. I would like for the "Counts" sheet to display:
5/27/2020 2
5/28/2020 1
5/29/2020 1

A	B	C	AB	AC
1234	JOHN	DOE	5/28/2020
	MINNIE	MOUSE
1789	SANDRA	DOE	5/29/2020
2489	MICKEY	MOUSE	5/27/2020
	DONALD	DUCK	5/27/2020

Is this possible?

Thank you for all of your help!

 

[DanteAmor]

Sorry i misunderstood.
So you want the results in the "Audit Counts" sheet, the list of dates in column A and the count in column B.
It is not necessary to create the "Audit Counts" sheet in every run, just create the sheet and run the macro.

This is what I understand.
Before running the macro (Audit Counts sheet):

varios 28may2020.xlsm
	A	B
1	Date	Count
2
3
4
5
Audit Counts

I have 3 sheets (sheet1, sheet2 and sheet3):

varios 28may2020.xlsm
	AB
2	26/05/2020
3	27/05/2020
4	28/05/2020
5	29/05/2020
6	30/05/2020
Sheet1

varios 28may2020.xlsm
	AB
2	26/05/2020
3	27/05/2020
Sheet2

varios 28may2020.xlsm
	AB
2	26/05/2020
3	27/05/2020
4	28/05/2020
Sheet3

After running the macro:

varios 28may2020.xlsm
	A	B
1	Date	Count
2	26/05/2020	3
3	27/05/2020	3
4	28/05/2020	2
5	29/05/2020	1
6	30/05/2020	1
Audit Counts

If the above is correct, try this

Sub CountDates()
  Dim sh As Worksheet, sh1 As Worksheet
  Dim a As Variant, dic As Object, i As Long
  
  Set sh1 = Sheets("Audit Counts")
  Set dic = CreateObject("Scripting.Dictionary")
  
  sh1.Rows("2:" & Rows.Count).ClearContents
  
  For Each sh In Sheets
    a = sh.Range("AB2", sh.Range("AB" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(a)
      If a(i, 1) <> "" And IsNumeric(a(i, 1)) Then
        dic(a(i, 1)) = dic(a(i, 1)) + 1
      End If
    Next
    Erase a
  Next
  sh1.Range("A2").Resize(dic.Count, 2).Value = Application.Transpose(Array(dic.keys, dic.items))
End Sub

 

[ffionnah]

Hi!
Not a problem. Thank you for your quick reply. Unfortunately, our firewalls do not allow for creating dictionaries. Is there a way around this? I tried to google a bit but I didn't find much that provided clarity!

 

[DanteAmor]

Add “Microsoft Scripting Runtime”using Tools->References from the VB menu

And try this

Sub CountDates()
  Dim sh As Worksheet, sh1 As Worksheet
  Dim a As Variant, dic As Dictionary, i As Long
  
  Set sh1 = Sheets("Audit Counts")
  Set dic = CreateObject("Scripting.Dictionary")
  
  sh1.Rows("2:" & Rows.Count).ClearContents
  
  For Each sh In Sheets
    a = sh.Range("AB2", sh.Range("AB" & Rows.Count).End(3)).Value2
    For i = 1 To UBound(a)
      If a(i, 1) <> "" And IsNumeric(a(i, 1)) Then
        dic(a(i, 1)) = dic(a(i, 1)) + 1
      End If
    Next
    Erase a
  Next
  sh1.Range("A2").Resize(dic.Count, 2).Value = Application.Transpose(Array(dic.keys, dic.items))
End Sub

Before presenting another alternative. Can you answer, if the images that I presented, is what you really want?

 

[ffionnah]

Hi,
Thank you for all of your help! This code did work. I had to have our IT department whitelist the line item. Thanks again!

 

[DanteAmor]

Im glad to help you, thanks for the feedback.