Spreadsheet to count outcomes of another spreadsheet every week

ive been set a challenge to create an excel document that will show me how many Y and N for a certain person each week.

We have a master Excel document, called Master. in this document there are 3 columns, name, date, and y/n.

I need to create another excel document that will let me, using a form, type in a name and select a week to give me results on how many Y for that person and how many N in that week, from the master document.

I hope this makes sense, I have attached two documents that will hopefully help.

Martin

Delete current code in Userform code module and replace with the following.
This is assuming "Master.xlsx" is located in the same folder as "Search.xlsm", so you will need to change the folder path.

Option Explicit

Private myList

Private Sub Userform_Initialize()
    Dim myWeek As Long, cn As Object, rs As Object, x, myDir As String
    Sheets("results").Range("b5:b8").ClearContents
    myWeek = WorksheetFunction.WeekNum(Date)
    myDir = ThisWorkbook.Path  '<---change the folder path for "master.xlsx", if needed
    With wkcombo
        .List = Sheets("Week").Range("a2:A53").Value
        .ListIndex = myWeek - 1
    End With
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=Yes;"
        .Open myDir & "\master.xlsx"
    End With
    rs.Open "Select Distinct `Name` From `Sheet1$`", cn, 3
    x = rs.GetRows
    Me.nmComb.List = Application.Transpose(x): rs.Close
    rs.Open "Select * From `Sheet1$`", cn, 3
    myList = rs.GetRows
    Set cn = Nothing: Set rs = Nothing
End Sub

Private Sub Search_Click()
    Dim myName As String, sDate As Date, eDate As Date, i As Long, y As Long, n As Long
    myName = Me.nmComb.Value
    sDate = Application.VLookup(Me.wkcombo.Value, Sheets("week").Range("a2:c53"), 2, False)
    eDate = Application.VLookup(Me.wkcombo.Value, Sheets("week").Range("a2:c53"), 3, False)
    For i = 0 To UBound(myList, 2)
        If myList(0, i) = myName Then
            If (myList(1, i) >= sDate) * (myList(1, i) <= eDate) Then
                If LCase$(myList(2, i)) = "y" Then
                    y = y + 1
                Else
                    n = n + 1
                End If
            End If
        End If
    Next
    Sheets("results").Range("b5").Resize(4).Value = Application.Transpose(Array(Me.nmComb.Value, Me.wkcombo.Value, y, n))
End Sub

Private Sub Cancel_Click()
    Unload Me
End Sub

Thank You
It was working however no i have added more names it seems to have stopped working with the error runtime error 13 Type Mismatch, on debugging it happens when it gets to the below code.

rs.Open "Select * From `Sheet1$`", cn, 3
myList = rs.GetRows
Set cn = Nothing: Set rs = Nothing
End Sub

Can not replicate the issue, it is working fine when add/remove data.

Need to see your "Master" workbook.

because of confidential information I couldn't show you the exact document we use that I have been trying to copy the code into and had to change some of the values as Sheet1 is actually name Raw and the Name column is operator name. To make this easier to understand I have made a similar document that hopefully will help. probably would have been easier for me to have done this in the first place but thought I could just copy the code and change certain values.


The document is set out exactly as the document im using, so the headings for each column is in row 6 and i used the exact headings for the columns, I have then highlighted the 2 columns that would be used in the code.

Thank You
Martin

I don't care about confidentiality, you can still make it with dummy data, but the layout MUST be EXACTLY the same as your original.

Do I continue assuming ALL BLANK rows above row 6?

yes that is correct and column A is blank

Sorry one more thing, if you can would it be possible to add another column of total Y for that person and a Total N between weeks 1 and 52

Change "Search_Click" sub routine to the following code.
It gives you Total Y in B9 & Total N in B10, and if you want total, just use the formula like =sum(b9:b10) in B11.

Private Sub Search_Click()
    Dim myName As String, sDate As Date, eDate As Date, DateS As Date, DateE As Date
    Dim i As Long, y As Long, n As Long, yTotal As Long, nTotal As Long
    If IsEmpty(myList) Then MsgBox "No data in Database", vbCritical: Exit Sub
    myName = Me.nmComb.Value
    With Sheets("week")
        sDate = Application.VLookup(Me.wkcombo.Value, .Range("a2:c53"), 2, False)
        eDate = Application.VLookup(Me.wkcombo.Value, .Range("a2:c53"), 3, False)
        DateS = .Range("b2").Value
        DateE = .Range("c53").Value
    End With
    For i = 0 To UBound(myList, 2)
        If myList(0, i) = myName Then
            If (myList(1, i) >= DateS) * (myList(1, i) <= DateE) Then
                If LCase$(myList(2, i)) = "y" Then
                    yTotal = yTotal + 1
                Else
                    nTotal = nTotal + 1
                End If
            End If
            If (myList(1, i) >= sDate) * (myList(1, i) <= eDate) Then
                If LCase$(myList(2, i)) = "y" Then
                    y = y + 1
                Else
                    n = n + 1
                End If
            End If
        End If
    Next
    Sheets("results").Range("b5").Resize(6).Value = _
    Application.Transpose(Array(Me.nmComb.Value, Me.wkcombo.Value, y, n, yTotal, nTotal))
End Sub

that's great ill use that to but I need the total of all the Y's out of the master document for the person chosen.

For example Total Y's in that document for Martin only and all N's for Martin
so the result would look something like

Name Martin
Week 20
Y 26
N 34


Year to Date
Y 432
N 672

Those numbers are nothing to me.
If you upload a workbook with the data results the same, it would help.

here is the search document explaining the results

That doesn't really help.
I need to see "example.xlsx" with the data, so I can check the results.

Hope these help

Change to

Option Explicit

Private myList

Private Sub Userform_Initialize()
    Dim myWeek As Long, cn As Object, rs As Object, x, myDir As String
    Sheets("results").Range("b5:b10,e6,c7:d8").ClearContents
    myWeek = WorksheetFunction.WeekNum(Date)
    myDir = ThisWorkbook.Path  '<---change the folder path for "master.xlsx", if needed
    With wkcombo
        .List = Sheets("Week").Range("a2:A53").Value
        .ListIndex = myWeek - 1
    End With
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    With cn
        .Provider = "Microsoft.Ace.OLEDB.12.0"
        .Properties("Extended Properties") = "Excel 12.0;HDR=Yes;"
        .Open myDir & "\example.xlsx"
    End With
    rs.Open "Select Distinct `Operator Name` From `Raw$` Where `Operator Name` Is Not Null;", cn, 3
    If rs.RecordCount Then
        x = rs.GetRows: Me.nmcomb.Column = x
    End If
    rs.Close
    rs.Open "Select  `Operator Name`, `Date`, `Y/N`, `Id Number` From `Raw$` Where " & _
            "`Operator Name` Is Not Null Order By `ID Number`", cn, 3  '<-- changed
    If rs.RecordCount Then myList = rs.GetRows
    Set cn = Nothing: Set rs = Nothing
End Sub

Private Sub Search_Click()
    Dim myName As String, sDate As Date, eDate As Date
    Dim i As Long, x(1 To 2, 1 To 3) As Long, FDate As Date
    If IsEmpty(myList) Then MsgBox "No data in Database", vbCritical: Exit Sub
    myName = Me.nmcomb.Value
    With Sheets("week")
        sDate = Application.VLookup(Me.wkcombo.Value, .Range("a2:c53"), 2, False)
        eDate = Application.VLookup(Me.wkcombo.Value, .Range("a2:c53"), 3, False)
        FDate = .[b2]
    End With
    For i = 0 To UBound(myList, 2)
        If myList(0, i) = myName Then
            If (myList(1, i) >= FDate) * (myList(1, i) <= Date) Then
                If LCase$(myList(2, i)) = "y" Then
                    x(1, 3) = x(1, 3) + 1
                Else
                    x(2, 3) = x(2, 3) + 1
                End If
            End If
            If (myList(1, i) >= sDate) * (myList(1, i) <= eDate) Then
                If LCase$(myList(2, i)) = "y" Then
                    x(1, 1) = x(1, 1) + 1
                Else
                    x(2, 1) = x(2, 1) + 1
                End If
            ElseIf (myList(1, i) >= sDate - 7) * (myList(1, i) <= eDate - 7) Then
                If LCase$(myList(2, i)) = "y" Then
                    x(1, 2) = x(1, 2) + 1
                Else
                    x(2, 2) = x(2, 2) + 1
                End If
            End If
        End If
    Next
    With Sheets("results")
        .Range("b5:b6").Value = Application.Transpose(Array(Me.nmcomb.Value, Me.wkcombo.Value))
        .Range("b7:d8").Value = x
        .Range("e6") = Left(myList(3, UBound(myList, 2)), 1) & Val(Mid$(myList(3, UBound(myList, 2)), 2)) + 1
    End With
End Sub

Private Sub Cancel_Click()
    Unload Me
End Sub

brilliant stuff! thank you for your help