Calculating Last Vote

[willhh3]

Hello!

I need some help with the sample file. I'm trying to calculate the most recent vote that 1 of 4 people made and apply a set status. I've include the below conditions in the sample file and what I think the output should look like (Sample_Conditions tab). The Votes and Voter List tabs will be what is in the weekly workbook. Any help would be appreciated.

Conditions:
All four people on the Voter List tab, must vote prior to the Deadline indicated.
They each can vote multiple times on one order number, but we are only concerned with the last vote.
Voters may not vote at all.
There is a varying number of rows week to week, depending on how may order numbers there are for the week.


Trim list down to last vote for each person that is listed on the Voter List tab.


If last vote equals "Approve" or "Defer" and is before the deadline then Status equals "Met"
If last vote equals "Approve" or "Defer" and is after the deadline, then Status equals "Missed"


If the a person in the Voter List doesn't have a row associated with an Order number, they didn't vote.
If this condition is met, add a row with the Order Number and the Voter Name. Date/Time is blank and Status equals "No Vote"

[willhh3]

Anybody able to help me out with this?

[willhh3]

Well, have to say this is the first time I was unable to get some help. I did get an answer to my question from another source, so closing the thread.

[Aussiebear]

Well, have to say this is the first time I was unable to get some help. I did get an answer to my question from another source, so closing the thread.

Thank you for following the forum rules relating to multiform posting..... Firstly, perhaps if others had the link, then they might have been in a position to assist you after seeing where the discussion was heading. Secondly, you started a discussion here, that others may wish to learn from down the track, however since you selfishly closed the thread without providing a solution to the issue then this thread becomes a dead link. Course all that could change with a little act of generosity on your behalf. Can you find it within you?

[willhh3]

Sorry about that. I was thinking clearly and should have posted what I got. Haven't been back here in a while so just saw this. Not sure what link I didn't use. Thought I had everything posted so anyone could look at. Anyway here is what I was able to get with help from some folks in another forum.

Sub Create_Summary()
Dim dOrders As Object:  Set dOrders = CreateObject("Scripting.Dictionary")
Dim ws1 As Worksheet:   Set ws1 = Sheets("Sample_Conditions")
Dim ws3 As Worksheet:   Set ws3 = Sheets("Voter List")
Dim ws4 As Worksheet:   Set ws4 = Sheets("Output") 'a new sheet that you need to create.  Feel free to change the sheet name here
Dim arrVoters As Variant, k As Variant, arrOrders As Variant
Dim i As Long, ii As Long
Dim rVoter As Range

Application.ScreenUpdating = False

If Not Evaluate("=ISREF('" & ws4.Name & "'!A1)") Then
    MsgBox ("You didn't make an output sheet")
    Exit Sub
Else
    ws1.Range("A1").EntireRow.Copy ws4.Range("A1")
End If

arrVoters = ws3.Range("A2:A" & ws3.Range("A" & Rows.Count).End(xlUp).Row)
arrOrders = ws1.Range("A2:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row)

For i = LBound(arrOrders, 1) To UBound(arrOrders, 1)
    dOrders(arrOrders(i, 1)) = 1
Next i

For Each k In dOrders.keys
    With ws1
        .AutoFilterMode = False
        .Range("A1:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter 1, k
        For ii = LBound(arrVoters, 1) To UBound(arrVoters, 1)
            Set rVoter = .Range("C1:C" & ws1.Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Find(arrVoters(ii, 1), , xlValues, xlWhole, , xlPrevious)
            If Not rVoter Is Nothing Then
                If .Range("E" & rVoter.Row).Value > .Range("B" & rVoter.Row).Value Then 'met
                    rVoter.EntireRow.Copy ws4.Range("A" & Rows.Count).End(3)(2)
                    ws4.Range("F" & Rows.Count).End(3)(2).Value = "Met"
                Else 'missed
                    rVoter.EntireRow.Copy ws4.Range("A" & Rows.Count).End(3)(2)
                    ws4.Range("F" & Rows.Count).End(3)(2).Value = "Missed"
                End If
            Else 'no vote
                .Range("C2:C" & ws1.Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells(1, 1).EntireRow.Copy ws4.Range("A" & Rows.Count).End(3)(2)
                ws4.Range("B" & ws4.Range("A" & Rows.Count).End(xlUp).Row, "D" & ws4.Range("A" & Rows.Count).End(xlUp).Row).ClearContents
                ws4.Range("C" & Rows.Count).End(3)(2).Value = arrVoters(ii, 1)
                ws4.Range("F" & Rows.Count).End(3)(2).Value = "No Vote"
            End If
        Next ii
        .ListObjects("Table1").Range.AutoFilter Field:=1
    End With
Next k

Application.ScreenUpdating = True
    
End Sub

[SamT]

Thank you. That was very nice of you.