Count How Many Items Contain Certain Value 2

[alexbel]

Hi,

I have a form which is used to add items to the test. Here are the fields on the forms:

Item Question
Possible Answers
Correct Answer
Case Text
Level 1 Classification
Level 2 Classification

When the user adds an item to the test, how can I have the program count how many level 1 of certain value and how many level 2 of certain are currently on the test?

Here's how I want it took look:

Level 1

Math 4


Level 2

Algebra 2
Geometry 2


If possible, I want this to be in a report.

Do you understand what I am trying to do?


Thank you!

 

[lewds]

Hi..

DCOUNT can total items from a table with multiple criteria

a textbox on your form could hold the values for each catagory

For a report..

You could create queries with multiple criteria and base your report on them with grouping and summing

 

[alexbel]

Can you do this without basing it on a table?

Thank you!

 

[PHV]

You may consider a Scripting.Dictionary object (or a VBA Collection)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[alexbel]

Here's in essence what I want to do:

Say I have a text box with the following values in it:

Math
Science
Math
Reading
Writing
Science
Math
Math
Writing

I want to compute how many total Math Values there are, how many total Science Values there are, etc....

So in this case, I want the finished product to look something like this:

Math (4)
Science (2)
Reading (1)
Writing (2)

How can this be done?

Thank you

 

[Zion7]

alexbel, you can use the InStr(), Mid() & Len() functions.

First thing, if the values you are searching for, are predetermined (I assume, Yes), Loop through Them.

Are they in a table, create recordset....
I'll put them in an array, by hand

Sub Count()
Dim vSubject As Variant
Dim iFind, x, c As Integer
Dim sNewTextBox, sSubject, aSubject As String

vSubject = Array("Math", "English", "Science", "Writing", "Français")

For x = 0 To UBound(vSubject)
sSubject = vSubject(x)
sNewTextBox = "Math, English, Math, Science, Writing, Français, Writing, Math, English, Math, Science, Math, English, Math)"
iFind = InStr(sNewTextBox, sSubject)
Do Until iFind = 0
iFind = InStr(sNewTextBox, sSubject)
If iFind > 0 Then
c = c + 1
sNewTextBox = Mid(sNewTextBox, iFind + Len(sSubject))
End If
Loop
aSubject = aSubject & sSubject & "(" & c & ") "
c = 0
Next x
Debug.Print aSubject
End Sub

If you put this, in a standard module, you'll see the results, And by reading the code, you'll get the idea, or see the potential.

Near the top of the procedure, I wrote..
sNewTextBox = "Math, English, Math, Science, Writing, Français, Writing, Math, English, Math, Science, Math, English, Math)"
Change this to..
sNewTextBox = Name of textBox, you want to search.(Change it only here.)

Any questions, reply!

Hope this helps, good luck!

 

[alexbel]

dboulos,

First thing, if the values you are searching for, are predetermined (I assume, Yes)

Actually, the values are not predetermined. So I need a generic code that will work regardless of what values are present in the text box.

Thank you

 

[Zion7]

I meant the options to search for, are predetermined, You know, it's either, Math, English, Science, History, etc.that will be in the text box.
This will be the initial loop, to check the textbox for these values.
I created an array, with these subjects. You might have them already, in a particular table. Either way, you know what to search for, English, Math, science etc... not Cars, Coffee, Apartments, Concert Tickets....y'know wut I mean.

What's in the text box, yes, is not predetermined, the procedure covers all the possible options. Try it, you'll see the results, and be able to modify, accordingly.

Instead of the array, you might create a recordset, if the subject options, are in a table. Outside of the that, once you have the initial options to search for, it's very dynamic.

 

[PHV]

Take a look at the Split function and at the Scripting.Dictionary object.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[JeffTullin]

Use a table and a query.

Create a spare table (call it Table1).
Have one field in it : 'NAME'

Empty it every time:

DoCmd.runSQL "Delete * from Table1;"

Then iterate through the items in the text box, and add them to the table one by one.

For x = 1 to <items>
Docmd.RunSQL
"insert into table1 values('" & theitem &"')"
next


Now that you have a table with all the items in it, run this query:

SELECT Table1.NAME, Count(Table1.NAME) AS CountOfNAME
FROM Table1
GROUP BY Table1.NAME;

 

[alexbel]

Hi,

Thank you all for your help. I have found the solution that I have been looking for!

Here's the code that I am using that a member at dBforums has provided:

  Dim i As Long, x As Long, a$
    Dim Strg As String
    Dim StrgArray() As String
    Dim Source As String
    
    Me.Text152 = ""
    Source = Trim(Me.Text150): x = 0
    'Place the individual items in the text box (Text150) into a String Array;
    For i = 1 To Len(Source)
        a$ = Mid$(Source, i, 1)
        If a$ = Chr$(10) Then GoTo Cont1
        If a$ = Chr$(13) Then
           ReDim Preserve StrgArray(x)
           StrgArray(x) = Strg
           x = x + 1
           Strg = "": a$ = ""
           GoTo Cont1
        End If
        Strg = Strg & a$
Cont1:
    Next i
    If Strg <> "" Then
       ReDim Preserve StrgArray(x)
       StrgArray(x) = Strg
       Strg = "": a$ = ""
    End If

    'Sort out the String Array into counted groups;
    Dim j As Long, Hit As Boolean, k As Integer
    Dim StrgArrayTmp() As String, Hit2 As Integer
    k = 0
    For i = 0 To UBound(StrgArray)
        a$ = StrgArray(i)
        On Error Resume Next
        For j = 0 To UBound(StrgArrayTmp)
           If Err <> 0 Then GoTo ByPass
           If a$ = Left$(StrgArrayTmp(j), Len(a$)) Then Hit = True: Exit For
        Next j
        If Err <> 0 Then Err = 0
        On Error GoTo 0
ByPass:
        If Hit = True Then
           Hit = False
           a$ = ""
             GoTo Cont2
        End If
        
        For x = 0 To UBound(StrgArray)
           If a$ = StrgArray(x) Then Hit2 = Hit2 + 1
        Next x
        ReDim Preserve StrgArrayTmp(k)
        StrgArrayTmp(k) = a$ & "(" & Hit2 & ")" & vbNewLine
        k = k + 1: Hit2 = 0
Cont2:
    Next i
    
    'Display the counted grouped item within TextBox 2
    On Error Resume Next
    For i = 0 To UBound(StrgArrayTmp)
       Me.Text152 = Me.Text152 & StrgArrayTmp(i)
    Next i
    
    'Erase the Arrays from memory.
    Erase StrgArray, StrgArrayTmp

Text150 is the unsorted box with the following values:

Math
Science
Math
Reading
Writing
Science
Math
Math
Writing


Text152 is the sorted text box with the following values in it after the code has run:

Math (4)
Science (2)
Reading (1)
Writing (2)


Thank you all again!

I appreciate it!