Counting number of Times "name" appears across multiple sheets

[underpar]

Hello:
This is a tough question to verbalize but I'll try my best. I will have a workbook with multiple sheets...one for each day. The sheets will show the names of people visiting a website. What I'm trying to do, is have a count of the number of times each "name" hit the website, but I won't know the names in advance. Maybe the question will be clearer after looking at the photos attached.

DAY 1 Sheet: shows the names (which I don't know in advance) who visited the website.
DAY 2 Sheet: shows the names (which I don't know in advance) who visited the website. It's the same people as Day 1.
DAY 3 Sheet: shows the names (which I don't know in advance) who visited the website.This time, 2 names are the same as previous days but one is different.
SUMMARY Sheet: Is there a way to show each name and the number of times they appear in the "day sheets". Since I don't know the names in advance, I can't populate the Summary Sheet with names.

Sorry for the rambling and I appreciate your help.
Cheers!

 

[Eric W]

Assuming your sheets are named and formatted as in your screenprints, you can try this macro. Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste the following code into the screen that opens:

Sub CountNames()
Dim d As Object, s As Worksheet, ar1 As Variant, i As Long
Dim d1 As Variant, d2 As Variant, op() As Variant

    Set d = CreateObject("Scripting.Dictionary")
    For Each s In Worksheets
        If s.Name Like "Day *" Then
            ar1 = s.Range("B3:C" & s.Cells(Rows.Count, "B").End(xlUp).Row).Value
            For i = 1 To UBound(ar1)
                d(ar1(i, 1) & "|" & ar1(i, 2)) = d(ar1(i, 1) & "|" & ar1(i, 2)) + 1
            Next i
        End If
    Next s
    
    ReDim op(1 To d.Count, 1 To 3)
    d1 = d.keys
    d2 = d.items
    For i = 0 To d.Count - 1
        op(i + 1, 1) = Split(d1(i), "|")(0)
        op(i + 1, 2) = Split(d1(i), "|")(1)
        op(i + 1, 3) = d2(i)
    Next i
    Sheets("Summary").Range("B2:D2") = Array("Last", "First", "Count")
    Sheets("Summary").Range("B3").Resize(d.Count, 3) = op
    
End Sub

Press Alt-Q to close the editor. Press Alt-F8 to open the macro selector. Select CountNames and click Run. That should do it for you.

 

[underpar]

Assuming your sheets are named and formatted as in your screenprints, you can try this macro. Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste the following code into the screen that opens:

Sub CountNames()
Dim d As Object, s As Worksheet, ar1 As Variant, i As Long
Dim d1 As Variant, d2 As Variant, op() As Variant

    Set d = CreateObject("Scripting.Dictionary")
    For Each s In Worksheets
        If s.Name Like "Day *" Then
            ar1 = s.Range("B3:C" & s.Cells(Rows.Count, "B").End(xlUp).Row).Value
            For i = 1 To UBound(ar1)
                d(ar1(i, 1) & "|" & ar1(i, 2)) = d(ar1(i, 1) & "|" & ar1(i, 2)) + 1
            Next i
        End If
    Next s
   
    ReDim op(1 To d.Count, 1 To 3)
    d1 = d.keys
    d2 = d.items
    For i = 0 To d.Count - 1
        op(i + 1, 1) = Split(d1(i), "|")(0)
        op(i + 1, 2) = Split(d1(i), "|")(1)
        op(i + 1, 3) = d2(i)
    Next i
    Sheets("Summary").Range("B2:D2") = Array("Last", "First", "Count")
    Sheets("Summary").Range("B3").Resize(d.Count, 3) = op
   
End Sub

Press Alt-Q to close the editor. Press Alt-F8 to open the macro selector. Select CountNames and click Run. That should do it for you.

Hi Eric:
Thank you very much for your help! I really appreciate it. This takes me back to the days when I wrote VERY small macros for Lotus 1-2-3 and have forgotten how over the years.
Just one question: the data in rows B and C may be 50 or 100 or even 150 rows deep for each day. Would you mind indicating the revisions necessary in the macro to accomodate this?
Thanks again.
Cheers,
Mike

 

[Eric W]

No revisions!

This line:

ar1 = s.Range("B3:C" & s.Cells(Rows.Count, "B").End(xlUp).Row).Value

finds the last used row on each sheet. I was more worried that you might have a different starting row, or different columns, or even named your sheets differently. This macro reads any sheet starting with "Day " and ignores the rest, and puts the results on the sheet named Summary. Any of that can be changed if needed, but the last row on each sheet is already accounted for!

 

[underpar]

No revisions!

This line:

ar1 = s.Range("B3:C" & s.Cells(Rows.Count, "B").End(xlUp).Row).Value

finds the last used row on each sheet. I was more worried that you might have a different starting row, or different columns, or even named your sheets differently. This macro reads any sheet starting with "Day " and ignores the rest, and puts the results on the sheet named Summary. Any of that can be changed if needed, but the last row on each sheet is already accounted for!

Fantastic Eric! Thank you so much. You have saved me a lot of time!
Cheers,
Mike

 

[underpar]

Fantastic Eric! Thank you so much. You have saved me a lot of time!
Cheers,
Mike

...just one hiccup: I get an error message "Run time error 9, subscript out of range". When I press debug, this line is highlighted in yellow: ReDim op(1 To d.Count, 1 To 3)

 

[Eric W]

Did you run the macro on an empty workbook? Or a workbook with no data to gather? If the number of unique items is 0, you'd get that message.

 

[underpar]

Did you run the macro on an empty workbook? Or a workbook with no data to gather? If the number of unique items is 0, you'd get that message.

I actually created a brand new workbook and saved it as an .xlsm. Then I entered the code. Saved, closed and re-opened the workbook, ran the macro and received the same error messge.
Thanks for helping....back to work now for a while!

 

[Eric W]

Is the data in the same rows/columns as your original pictures?

 

[underpar]

Hi Eric: All of the "day" sheets are setup as per the jpg...just different names in day 2, etc.

Thanks,
Mike