VBA: Custom Count and Search Function Help Needed

[Ottsel]

I have this custom function I'm working on. the setup is as follows:

=CountAwards(B2, 2023)

The sheet its referencing is "TRACKER". I want to be able to reference B2 or any cell really as the main search. In this example on the TRACKER sheet B2, B6, B7, and B8 are whats in being looked for. If whats in Column O equals AWARDED, then count if the other requires are met: J must equal the year that's selected, which in this example is 2023 and whats in column C must be unique. If whats in column C occurs again and the value changes in column O it needs to update the count. So, in this example below row 2's status is AWARDED, so +1 to the overall count, but later its changed in row 7 from AWARDED to LOST, so the count would change. So, with this example the answer should equal: 1, since only 1 was truly AWARDED. Since row 1 was in 2022 it won't be picked up in the count. Any help or direction regarding this would be highly appreciated! Also, if any form of the word "LOST" is located it would be great to have that included. For some reason people tend to put "ASSUMED LOST" even though its been noted to avoid that.

Book1
	B	C	D
2	abc		#NAME?
Sheet2

Cell Formulas
Range	Formula
D2	D2	=CountAwarded(B2,2023)

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1		abc	place 0							12/20/2022					AWARDED
2		abc	PLACE 1							9/5/2023					AWARDED
3		def	VILLAGE 1							9/8/2023					ASSUMED LOST
4		def	VILLAGE 2							9/13/2023					AWARDED
5		def	VILLAGE 2							9/15/2023					LOST
6		abc	place 2							9/18/2023					LOST
7		abc	place 1							9/20/2023					LOST
8		abc	place 4							10/1/2023					AWARDED
TRACKER

Function CountAwards(lookupValue As Range, year As Integer) As String
    Dim ws As Worksheet
    Dim count As Integer
    Dim cell As Range
    Dim lastRow As Long
    
    Set ws = Worksheets("TRACKER")
    
    lastRow = ws.Cells(ws.Rows.count, "B").End(xlUp).Row
    
    count = 0
    
    For Each cell In ws.Range("B2:B" & lastRow)
        If cell.Value = lookupValue.Value Then
            If cell.Offset(0, 12).Value = "AWARDED" And year(cell.Offset(0, 9).Value) = year Then
                If Application.WorksheetFunction.CountIf(ws.Range("C2:C" & lastRow), cell.Offset(0, 1).Value) = 1 Then
                    count = count + 1
                ElseIf Application.WorksheetFunction.CountIfs(ws.Range("C2:C" & lastRow), cell.Offset(0, 1).Value, ws.Range("O2:O" & lastRow), "LOST") > 0 Then
                    count = count - 1
                End If
            End If
        End If
    Next cell
    
    CountAwards = count
End Function

 

[DanteAmor]

The error that appears: "#NAME?" is because in the formula you have this:

=CountAwarded(B2,2023)


And the function has another name:
Function CountAwards(


You could put more possible scenarios, that is, what is the result in a case like the following, if it can occur:

varios 31oct2023.xlsm
	A	B	C							J					O
1		abc	PLACE 1							01/sep/2023					AWARDED
2		abc	PLACE 1							02/sep/2023					AWARDED
3		abc	PLACE 1							03/sep/2023					LOST
4		abc	PLACE 1							04/sep/2023					LOST
5		abc	PLACE 1							05/sep/2023					LOST
6		abc	PLACE 1							06/sep/2023					LOST
7		abc	PLACE 1							07/sep/2023					LOST
TRACKER

The result is -3?

Or in this case. What would be the result?

varios 31oct2023.xlsm
	A	B	C							J					O
1		abc	PLACE 1							01/sep/2023					AWARDED
2		abc	PLACE 1							02/sep/2023					AWARDED
3		abc	PLACE 1							03/sep/2023					LOST
4		abc	PLACE 1							04/sep/2023					AWARDED
5		abc	PLACE 1							05/sep/2023					AWARDED
6		abc	PLACE 1							06/sep/2023					AWARDED
7		abc	PLACE 1							07/sep/2023					AWARDED
TRACKER

----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --

 

[Ottsel]

The error that appears: "#NAME?" is because in the formula you have this:

=CountAwarded(B2,2023)


And the function has another name:
Function CountAwards(


You could put more possible scenarios, that is, what is the result in a case like the following, if it can occur:

varios 31oct2023.xlsm
	A	B	C							J					O
1		abc	PLACE 1							01/sep/2023					AWARDED
2		abc	PLACE 1							02/sep/2023					AWARDED
3		abc	PLACE 1							03/sep/2023					LOST
4		abc	PLACE 1							04/sep/2023					LOST
5		abc	PLACE 1							05/sep/2023					LOST
6		abc	PLACE 1							06/sep/2023					LOST
7		abc	PLACE 1							07/sep/2023					LOST
TRACKER

The result is -3?

Or in this case. What would be the result?

varios 31oct2023.xlsm
	A	B	C							J					O
1		abc	PLACE 1							01/sep/2023					AWARDED
2		abc	PLACE 1							02/sep/2023					AWARDED
3		abc	PLACE 1							03/sep/2023					LOST
4		abc	PLACE 1							04/sep/2023					AWARDED
5		abc	PLACE 1							05/sep/2023					AWARDED
6		abc	PLACE 1							06/sep/2023					AWARDED
7		abc	PLACE 1							07/sep/2023					AWARDED
TRACKER

----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --

The error that appears: "#NAME?" is because in the formula you have this:

=CountAwarded(B2,2023)


And the function has another name:
Function CountAwards(


You could put more possible scenarios, that is, what is the result in a case like the following, if it can occur:

varios 31oct2023.xlsm
	A	B	C							J					O
1		abc	PLACE 1							01/sep/2023					AWARDED
2		abc	PLACE 1							02/sep/2023					AWARDED
3		abc	PLACE 1							03/sep/2023					LOST
4		abc	PLACE 1							04/sep/2023					LOST
5		abc	PLACE 1							05/sep/2023					LOST
6		abc	PLACE 1							06/sep/2023					LOST
7		abc	PLACE 1							07/sep/2023					LOST
TRACKER

The result is -3?

Or in this case. What would be the result?

varios 31oct2023.xlsm
	A	B	C							J					O
1		abc	PLACE 1							01/sep/2023					AWARDED
2		abc	PLACE 1							02/sep/2023					AWARDED
3		abc	PLACE 1							03/sep/2023					LOST
4		abc	PLACE 1							04/sep/2023					AWARDED
5		abc	PLACE 1							05/sep/2023					AWARDED
6		abc	PLACE 1							06/sep/2023					AWARDED
7		abc	PLACE 1							07/sep/2023					AWARDED
TRACKER

----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --

Hey Dante!

My booklet crashed so I typed it on another workbook for the visual. Yes, it's suppose to be CountAwards. I was trying to get it to only count where AWARDED occurred and ignore counting LOSS, but if a duplicate occurs, then subtract or add accordingly. In your last example it would be 1, since the last time (September 1st, 2023) Place 1 occurred its status was AWARDED. Now, if it occurred again and it was LOST, then it would be 0. Hope that makes sense. Thanks for taking a look at this for me!

 

[bebo021999]

Try this code:

Option Explicit
Function CountAwards(lookupValue As Range, yr As Integer) As Long
Dim i&, rng, dic As Object, c&, item
Application.Volatile
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("TRACKER")
    rng = .Range("B1", .Cells(Rows.Count, "O").End(xlUp)).Value
End With
For i = 1 To UBound(rng)
    If rng(i, 1) = lookupValue And year(rng(i, 9)) = yr Then
        
        'if ARWARDED then +1 if contains *LOST* then -1
        If UCase(rng(i, 14)) = "AWARDED" Then
            c = 1
        ElseIf InStr(1, UCase(rng(i, 14)), "LOST") Then
            c = -1
        End If
        
        'generate dictionary with key= unique "place" and item=addup the "c"
        If Not dic.exists(UCase(rng(i, 2))) Then
            dic.Add UCase(rng(i, 2)), c
        Else
            dic(UCase(rng(i, 2))) = dic(UCase(rng(i, 2))) + c
        End If
    End If
Next

'iterate key, then addup the item if item>0 (award-lost>0)
For Each item In dic.items
    If item > 0 Then CountAwards = CountAwards + item
Next
End Function

 

[Ottsel]

Try this code:

Option Explicit
Function CountAwards(lookupValue As Range, yr As Integer) As Long
Dim i&, rng, dic As Object, c&, item
Application.Volatile
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("TRACKER")
    rng = .Range("B1", .Cells(Rows.Count, "O").End(xlUp)).Value
End With
For i = 1 To UBound(rng)
    If rng(i, 1) = lookupValue And year(rng(i, 9)) = yr Then
       
        'if ARWARDED then +1 if contains *LOST* then -1
        If UCase(rng(i, 14)) = "AWARDED" Then
            c = 1
        ElseIf InStr(1, UCase(rng(i, 14)), "LOST") Then
            c = -1
        End If
       
        'generate dictionary with key= unique "place" and item=addup the "c"
        If Not dic.exists(UCase(rng(i, 2))) Then
            dic.Add UCase(rng(i, 2)), c
        Else
            dic(UCase(rng(i, 2))) = dic(UCase(rng(i, 2))) + c
        End If
    End If
Next

'iterate key, then addup the item if item>0 (award-lost>0)
For Each item In dic.items
    If item > 0 Then CountAwards = CountAwards + item
Next
End Function

This worked perfectly! I'm now just trying to figure out the next step, but at least I have this go to off of. Someone failed to mention that when you type the year it has to always start from April 1st <year> and search through March 31st <year +1>.

Thanks for all the help you two!

 

[Ottsel]

Try this code:

Option Explicit
Function CountAwards(lookupValue As Range, yr As Integer) As Long
Dim i&, rng, dic As Object, c&, item
Application.Volatile
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("TRACKER")
    rng = .Range("B1", .Cells(Rows.Count, "O").End(xlUp)).Value
End With
For i = 1 To UBound(rng)
    If rng(i, 1) = lookupValue And year(rng(i, 9)) = yr Then
       
        'if ARWARDED then +1 if contains *LOST* then -1
        If UCase(rng(i, 14)) = "AWARDED" Then
            c = 1
        ElseIf InStr(1, UCase(rng(i, 14)), "LOST") Then
            c = -1
        End If
       
        'generate dictionary with key= unique "place" and item=addup the "c"
        If Not dic.exists(UCase(rng(i, 2))) Then
            dic.Add UCase(rng(i, 2)), c
        Else
            dic(UCase(rng(i, 2))) = dic(UCase(rng(i, 2))) + c
        End If
    End If
Next

'iterate key, then addup the item if item>0 (award-lost>0)
For Each item In dic.items
    If item > 0 Then CountAwards = CountAwards + item
Next
End Function

Think I got it...
Changed

[QUOTE]
If rng(i, 1) = lookupValue And year(rng(i, 9)) = yr Then
[/QUOTE]

to

If rng(i, 1) = lookupValue And rng(i, 9) >= DateSerial(yr, 4, 1) And rng(i, 9) <= DateSerial(yr + 1, 3, 31) Then