Find Exact Value within a string

[vladi305]

I have a function looking for a range of 5 columns and one row searching within a range of 5 columns and multiple rows as the pic attached.

The values on the right side are the one that need to be check if they match any of the value on the left side
one row at a time will be search through all the rows on the left side

So my function is giving me errors writing values on the G column
Also maybe there's a better way of writing this

I want to just write on column G if there's a value found either true or how many did it find 2 or 3 values or 4

Function CheckIfAnyWon2(Arg1 As Range, Arg12 As Range) As Double

Dim iCell As Range
Dim varVal As String
Dim varVal2 As String
Dim rangeArgl As String
Dim rangeArgl2 As String
Dim cnt As Integer
rangeArgl = Arg1.Address
rangeArgl2 = Arg12.Address

Dim LookInHere As String
Dim Counter As Integer
Dim SplitCatcher As Variant
Dim strA As String
Dim strBall1 As String
Dim strBall2 As String
Dim strBall3 As String
Dim strBall4 As String
Dim strBall5 As String
Dim strCurrentCellAddress As String
Dim intBallFound As Integer

Dim keepCnt As Integer
Dim intVal As Integer


'numbers selected from range
For Each iCell In Range(rangeArgl).Cells
varVal = varVal & iCell.Value & " "
Next iCell

LookInHere = varVal
SplitCatcher = Split(LookInHere, " ")
For Counter = 0 To UBound(SplitCatcher)
strA = SplitCatcher(Counter)
Select Case Counter
Case 0
strBall1 = strA & " "
Case 1
strBall2 = strA & " "
Case 2
strBall3 = strA & " "
Case 3
strBall4 = strA & " "
Case 4
strBall5 = strA & " "
End Select
Next


cnt = 0
intBallFound = 0
'check through data history
For Each iCell In Range(rangeArgl2).Cells
cnt = cnt + 1

If cnt = 5 Then

varVal2 = varVal2 & iCell.Value
keepCnt = keepCnt + 1
'check string for matches
If InStr(1, varVal2, strBall1) > 0 Then
intBallFound = intBallFound + 1
End If
If InStr(1, varVal2, strBall2) > 0 Then
intBallFound = intBallFound + 1
End If
If InStr(1, varVal2, strBall3) > 0 Then
intBallFound = intBallFound + 1
End If
If InStr(1, varVal2, strBall4) > 0 Then
intBallFound = intBallFound + 1
End If
If InStr(1, varVal2, strBall5) > 0 Then
intBallFound = intBallFound + 1
End If
varVal2 = ""
cnt = 0
If intBallFound > 0 Then
strCurrentCellAddress = "G" & keepCnt
Sheet17.Range(strCurrentCellAddress).Value = intBallFound & ""
End If
'ActiveWorkbook.Sheets("Sheet17").Cells(7, keepCnt).Value = intBallFound
intBallFound = 0
Else
varVal2 = varVal2 & iCell.Value & " "


End If


Next iCell



End Function

 

[vladi305]

Try to follow my 2nd request in #3: "manual input some expected results", instead of the unworking UDF

I just updated the file on the link showing the expected results

 

[bebo021999]

How about:

In M1 (with 1: count):
=check($A$1:$F$846,$H1:$L1,1)

N1 (with 2: retuns date)
=check($A$1:$F$846,$H1:$L1,2)

Fantasy5vba_Apr9.xlsm

drive.google.com

Option Explicit
Function Check(ByVal leftR As Range, rightR As Range, n As Single)
Dim i&, j&, c&, d&, max&, rng, r, res()
rng = leftR.Value
r = rightR.Value
ReDim res(1 To UBound(rng), 1 To 6)
For i = 1 To UBound(rng)
    c = 0
    For j = 2 To 6
        If rng(i, j) = r(1, j - 1) Then
           c = c + 1
        End If
    Next
    If c > max Then
        max = c: d = i
    End If
Next
Check = IIf(n = 1, max, rng(d, 1))
End Function

 

[vladi305]

How about:

In M1 (with 1: count):
=check($A$1:$F$846,$H1:$L1,1)

N1 (with 2: retuns date)
=check($A$1:$F$846,$H1:$L1,2)

Fantasy5vba_Apr9.xlsm

drive.google.com

Option Explicit
Function Check(ByVal leftR As Range, rightR As Range, n As Single)
Dim i&, j&, c&, d&, max&, rng, r, res()
rng = leftR.Value
r = rightR.Value
ReDim res(1 To UBound(rng), 1 To 6)
For i = 1 To UBound(rng)
    c = 0
    For j = 2 To 6
        If rng(i, j) = r(1, j - 1) Then
           c = c + 1
        End If
    Next
    If c > max Then
        max = c: d = i
    End If
Next
Check = IIf(n = 1, max, rng(d, 1))
End Function

That works thanks!