Loop throught a description, find a string and count - vbscript

Question

I have a table with, for this example, 2 columns:
Person
Description
I need to create a result table like this:
Person Yes No Total
John 1 5 6
Laura 4 9 13
Peter 0 1 1
Total 5 15 20
The person I get it straight, but for the description I have to do a check if there is a date inside the string, Nathan Rice helped me here about it: Get a range date and search a string. One Person can have N descriptions, so I need to loop it. If the date was found in description add 1 to Yes, else add 1 to No.
CODE UPDATED
<%
varYesTotal = 0
varNoTotal = 0
Do While Not rsPerson.EOF
varYes = 0
varNo = 0
strPersonName = rsPerson("Person")
Set rsCheckYesNo = T.Execute("SELECT Description FROM Person Where Person= '" & strPersonName & "' ORDER BY Person ASC")
strDescription= rsCheckYesNo("Description")
For intDateDiff = 0 to DateDiff("d",DataInicial,DataFinal)
arrDateParts = Split(DateAdd("d",intDateDiff,DataInicial),"/")
If arrDateParts(1) <= 9 Then
arrDateParts(1) = "0" & arrDateParts(1)
End If
strCheckDate = arrDateParts(0) & "/" & arrDateParts(1) & "/" & arrDateParts(2)
Do While Not rsCheckYesNo.EOF
strDescription= rsCheckYesNo("Description")
boolDateFound = False
If InStr(strDescription, strCheckDate) > 0 Then
boolDateFound = True
varYes = varYes + 1
Else
varNo = varNo + 1
End If
rsCheckYesNo.MoveNext
Loop
Next
%>

Answer 1

<%
Set rsPerson= T.Execute("SELECT DISTINCT Person FROM Table")
If Not rsPerson.EOF Then
%>
<table>
<thead>
<tr>
<th>Person</th>
<th>Yes</th>
<th>No</th>
<th>Total</th>
</tr>
</thead>
<%
'We need 2 sets of counters, one set that gets set
'to zero so we can total all the records.
varYesTotal = 0
varNoTotal = 0
Do While Not rsPerson.EOF
'The other set of counters gets reset per user
'so it should be inside the users loop.
varYes = 0
varNo = 0
strPersonName = rsPerson("Person")
Set rsCheckYesNo = T.Execute("SELECT Description FROM Person Where Person= '" & strPersonName & "' ORDER BY Person ASC")
strDescription= rsCheckYesNo("Description")
Do While Not rsCheckYesNo.EOF
'Start Nathan Rice Code
boolDateFound = False
For intDateDiff = 0 to DateDiff("d",DataInicial,DataFinal)
arrDateParts = Split(DateAdd("d",intDateDiff,DataInicial),"/")
If arrDateParts(1) <= 9 Then
arrDateParts(1) = "0" & arrDateParts(1)
End If
strCheckDate = arrDateParts(0) & "/" & arrDateParts(1) & "/" & arrDateParts(2)
If InStr(strDescription, strCheckDate) > 0 Then
boolDateFound = True
varYes = varYes + 1
Exit For
Else
varNo = varNo + 1
End If
Next
'End Nathan Rice Code
rsCheckYesNo.MoveNext
Loop
%>
<tbody>
<tr>
<td><%=strPersonName%></td>
<td><%=varYes%></td>
<td><%=varNo%></td>
<td><%=(varYes + varNo)%></td>
</tr>
</tbody>
<%
varYesTotal = varYesTotal + varYes
varNoTotal = varNoTotal + varNo
rsPerson.MoveNext
Loop
rsPerson.Close
%>
<tfoot>
<tr>
<td>Total</td>
<td><%=varYesTotal%></td>
<td><%=varNoTotal%></td>
<td><%=(varYesTotal+varNoTotal)%></td>
</tr>
</tfoot>
</table>
<%
End If
%>

Answer 2

Your plan should look like this:
PreP for whole task
Database
Date range
Total
Print header
Get persons
For all persons
PreP for person
Get name
Get descriptions
For all descriptions
Check and count
Next
PostP for person
Compute yes/no/all (one from two)
Print row
Update total
Next
PostP for whole task
Print total
Database
Looks like your code lacks the description loop.
Update:
In code:
Option Explicit
Dim greDate : Set greDate = New RegExp
greDate.Global = True
greDate.Pattern = "(\d{2})/(\d{2})/(\d{4})" ' dd/mm/yyyy
Dim aTotal : aTotal = Array(0,0,0)
Dim aTests : aTests = Array( _
Array( "peter" _
, "In 21/02/2014 something happened") _
, Array( "paul" _
, "pi 19/02/2014 pa 26/02/2014 po" _
, "In 21/02/2013 something happened") _
, Array( "mary" _
, "pi 19/02/2014 pu 20/02/2014 25/02/2014 26/02/2014 po" _
, "pi 19/02/2014 pu 20/02/2014 ") _
)
Dim aPers
Dim dtFrom : dtFrom = #2/20/2014#
Dim dtTo : dtTo = #2/25/2014#
For Each aPers In aTests
WScript.Echo "#####", aPers(0)
Dim aPSum : aPSum = Array(0, 0, 0)
Dim nDescr
For nDescr = 1 To UBound(aPers)
Dim sTest : sTest = aPers(nDescr)
WScript.Echo "-----", qq(sTest)
Dim aDates : aDates = getDatesFrom(sTest, dtFrom, dtTo)
If -1 = UBound(aDates) Then
WScript.Echo " no interesting dates found."
aPSum(1) = aPSum(1) + 1
Else
WScript.Echo " found (m/d/yyyy!)", Join(aDates, ", ")
aPSum(0) = aPSum(0) + 1
End If
Next
aPSum(2) = aPSum(0) + aPSum(1)
WScript.Echo "*****", Join(aPSum)
Dim i
For i = 0 To UBound(aTotal) : aTotal(i) = aTotal(i) + aPSum(i) : Next
Next
WScript.Echo "#####", Join(aTotal)
Function getDatesFrom(sText, dtFrom, dtTo)
ReDim aTmp(-1)
Dim oMTS : Set oMTS = greDate.Execute(sText)
Dim oMT, dtFound
For Each oMT In oMTS
' dd/mm/yyyy
dtFound = DateSerial(CInt(oMT.SubMatches(2)), cInt(oMT.SubMatches(1)), CInt(oMT.SubMatches(0)))
If dtFound >= dtFrom And dtFound <= dtTo Then
ReDim Preserve aTmp(Ubound(aTmp) + 1)
aTmp(Ubound(aTmp)) = dtFound
End If
Next
getDatesFrom = aTmp
End Function
Function qq(s) : qq = """" & s & """" : End Function
output:
cscript 21994835-2.vbs
##### peter
----- "In 21/02/2014 something happened"
found (m/d/yyyy!) 2/21/2014
***** 1 0 1
##### paul
----- "pi 19/02/2014 pa 26/02/2014 po"
no interesting dates found.
----- "In 21/02/2013 something happened"
no interesting dates found.
***** 0 2 2
##### mary
----- "pi 19/02/2014 pu 20/02/2014 25/02/2014 26/02/2014 po"
found (m/d/yyyy!) 2/20/2014, 2/25/2014
----- "pi 19/02/2014 pu 20/02/2014 "
found (m/d/yyyy!) 2/20/2014
***** 2 0 2
##### 3 2 5