?
Solved

Checking that a list of three numbers are a subset of six

Posted on 2005-05-08
5
Medium Priority
?
310 Views
Last Modified: 2010-05-18
I have a txt file which contains lines of six numbers e.g 1,2,3,4,5,6. I have another file which contains lines of 3 numbers e.g 1,2,3. I would like to open the file with 6 numbers in,  read a line then open my other file with 3 numbers in then check to see if any of the 3 numbers are within the line of six. Once this has checked the first line of six then goto the next line of six within the file and perform the same check. Once I have checked all of the lines of 6 in the file with my line of three I would then like to goto the next line of 3 numbers and perform the same check on all of the lines of six numbers on so on until I have looped thru all of the lines of 3 numbers. I would like to be able to create a spreadsheet/file with the results e.g there are 5 lines with  1,2,3. 10 lines with 456 etc. In addition, I would also like to be able to check for four matches , five matchs etc. This is for checking lottery tickets. I have VBA and have just started to use it thus my knowledge is limited. Any help appreciated!
0
Comment
Question by:bhattar
5 Comments
 
LVL 7

Expert Comment

by:Burbble
ID: 13954762
I think this may be close to what you want. See if the output is organized how you want it, I'm a little unclear on that.

To set this up:

Create a new Visual Basic project and save it to a folder containing the following text files:

3Numbers.txt:
¯¯¯¯¯¯¯¯¯¯¯
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20
1,2,3
4,5,6
7,8,9
0,1,2
3,4,5
6,7,8
9,10,11
12,13,14
15,16,17
18,19,20

6Numbers.txt:
¯¯¯¯¯¯¯¯¯¯¯
1,2,3,4,5,6
7,8,9,0,1,2
3,4,5,6,7,8
9,10,11,12,13,14
15,16,17,18,19,20



Now, on Form1 in the project, create three command buttons and a text box (position/size doesn't matter). Set the Text Box's MultiLine property to "True", and set its ScrollBars property to "2 - Vertical". Then click View > Code and paste the following:


Private Const Num_LBound = 0
Private Const Num_UBound = 20

Dim Numbers() As Long
Dim SixNumbers() As Collection

Private Sub ParseNumbers(NumberString As String, NumberCollection As Collection)
    Dim strRemainder As String

    strRemainder = NumberString
    Do While InStr(1, strRemainder, ",") <> 0
        NumberCollection.Add Mid(strRemainder, 1, InStr(1, strRemainder, ",") - 1)
        strRemainder = Mid(strRemainder, InStr(1, strRemainder, ",") + 1)
    Loop
    NumberCollection.Add strRemainder
End Sub

Private Sub Command1_Click()
    Dim FileNo As Integer
    Dim strTemp As String
    Dim ParsedNumbers As Collection

    Text1.Text = ""
    ReDim Numbers(Num_LBound To Num_UBound, Num_LBound To Num_UBound, Num_LBound To Num_UBound)
    FileNo = FreeFile
    Open App.Path & "\3Numbers.txt" For Input As #FileNo
        Do While Not EOF(1)
            Line Input #FileNo, strTemp
            If Len(strTemp) <> 0 Then
                Set ParsedNumbers = Nothing
                Set ParsedNumbers = New Collection
                ParseNumbers strTemp, ParsedNumbers
                Numbers(ParsedNumbers.Item(1), ParsedNumbers.Item(2), ParsedNumbers.Item(3)) = Numbers(ParsedNumbers.Item(1), ParsedNumbers.Item(2), ParsedNumbers.Item(3)) + 1
            End If
        Loop
    Close #FileNo
    Text1.Text = "Done."
End Sub

Private Sub Command2_Click()
    Dim Dim1 As Long
    Dim Dim2 As Long
    Dim Dim3 As Long

    Text1.Text = ""
    For Dim1 = Num_LBound To Num_UBound
    For Dim2 = Num_LBound To Num_UBound
    For Dim3 = Num_LBound To Num_UBound
        If Numbers(Dim1, Dim2, Dim3) <> 0 Then
            Text1.Text = Text1.Text & Dim1 & "," & Dim2 & "," & Dim3 & " -- " & Numbers(Dim1, Dim2, Dim3) & vbNewLine
        End If
    Next Dim3
    Next Dim2
    Next Dim1
End Sub

Private Sub Command3_Click()
    Dim FileNo As Integer
    Dim strTemp As String
    Dim ParsedNumbers As Collection
    Dim Dim1 As Long
    Dim Dim2 As Long
    Dim Dim3 As Long
    Dim lngElement As Variant
    Dim lngMatches As Long

    Text1.Text = ""
    FileNo = FreeFile
    Open App.Path & "\6Numbers.txt" For Input As #FileNo
        Do While Not EOF(1)
            Line Input #FileNo, strTemp
            If Len(strTemp) <> 0 Then
                Set ParsedNumbers = Nothing
                Set ParsedNumbers = New Collection
                ParseNumbers strTemp, ParsedNumbers
                For Dim1 = Num_LBound To Num_UBound
                For Dim2 = Num_LBound To Num_UBound
                For Dim3 = Num_LBound To Num_UBound
                    If Numbers(Dim1, Dim2, Dim3) <> 0 Then
                        lngMatches = 0
                        For Each lngElement In ParsedNumbers
                            If Dim1 = CLng(lngElement) Then lngMatches = lngMatches + 1
                            If Dim2 = CLng(lngElement) Then lngMatches = lngMatches + 1
                            If Dim3 = CLng(lngElement) Then lngMatches = lngMatches + 1
                        Next
                        If lngMatches <> 0 Then
                            Text1.Text = Text1.Text & "("
                            For Each lngElement In ParsedNumbers
                                Text1.Text = Text1.Text & lngElement & ","
                            Next
                            Text1.Text = Left$(Text1.Text, Len(Text1.Text) - 1)
                            Text1.Text = Text1.Text & ") -- " & lngMatches & " matches: " & "(" & Dim1 & "," & Dim2 & "," & Dim3 & ")" & vbNewLine
                        End If
                    End If
                Next Dim3
                Next Dim2
                Next Dim1
            End If
        Loop
    Close #FileNo
End Sub

Private Sub Form_Load()
    Me.Width = 7620
    Me.Height = 7905
    Command1.Caption = "Load Data"
    Command1.Top = 240
    Command1.Left = 240
    Command1.Width = 1575
    Command1.Height = 615
    Command2.Caption = "Count 3 Variants"
    Command2.Top = 1080
    Command2.Left = 240
    Command2.Width = 1575
    Command2.Height = 615
    Command3.Caption = "Count 6 Matches"
    Command3.Top = 1920
    Command3.Left = 240
    Command3.Width = 1575
    Command3.Height = 615
    Text1.Text = ""
    Text1.Top = 120
    Text1.Left = 2040
    Text1.Width = 5295
    Text1.Height = 7215
End Sub



Run the program, see if the output is desirable, I may have misinterpretted your question. I am not familiar with how to dynamically create spreadsheets, so I'm not really of much help there, the program's output is just generic text.

0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 2000 total points
ID: 13954829
You could try this.

I don't understand the bit about four and five matches. You might just need to use two more columns in the spreadsheet.

Sub CompareNumberFiles()
Dim f As Integer
Dim g As Integer
Dim r As Integer
Dim c As Integer
Dim n As Integer
Dim i As Integer
Dim j As Integer
Dim strLine3 As String
Dim strLine6 As String
Dim vThree
Dim vSix

f = FreeFile
Open "C:\File3.txt" For Input As #f
    Do Until EOF(f)
        r = r + 1
        c = 0
        Line Input #f, strLine3
        Application.ActiveSheet.Cells(r, 1) = strLine3
        vThree = Split(strLine3, ",") 'Assumes numbers are separated by commas as indicated in question
        g = FreeFile
        Open "C:\File6.txt" For Input As #g
            Do Until EOF(g)
                Line Input #g, strLine6
                vSix = Split(strLine6, ",")
                n = 0
                For i = 0 To 2
                    For j = 0 To 5
                        If vThree(i) = vSix(j) Then
                            n = n + 1
                        End If
                    Next j
                Next i
                If n = 3 Then
                    c = c + 1
                End If
            Loop
        Close #g
        Application.ActiveSheet.Cells(r, 2) = c
    Loop
Close #f
End Sub

0
 
LVL 18

Expert Comment

by:JR2003
ID: 13955956
I'm assuming that you have multiple lottery tickets that you want to check against the result of the lottery.
For this you will have the following input into the program
A file of the lottery result (a csv file containing just 6 numbers) called "c:\Result.txt".
A file of tickets purchased (a csv file containing multiple lines 6 numbers) called "c:\Tickets.txt".
The program will generate a file called "c:\WiningTickets.txt" that contains details of the winning tickets.

You will need to include a reference in the project (from the menu Project/References) to the "Microsoft Scripting Runtime"library. This library contains some very useful tools for reading text files and creating dictionary (colleciton) objects.


Private Sub Command1_Click()

    Dim fso As New Scripting.FileSystemObject
    Dim colResults As New Scripting.Dictionary
    Dim sResultLine As String
    Dim sTicketLine As String
    Dim sResultArray() As String
    Dim sTicketNumbers() As String
   
    Dim ResultFile As Scripting.TextStream
    Set ResultFile = fso.OpenTextFile("c:\Result.txt")
   
    Dim WinningTicketsFile As Scripting.TextStream
   
    sResultLine = ResultFile.ReadLine()
    sResultArray = Split(sResultLine, ",")
    Dim i As Long
    'Add the six numbers in the resuilt to a dictionary object
    For i = LBound(sResultArray) To UBound(sResultArray)
        colResults.Add Trim(sResultArray(i)), sResultArray(i)
    Next i
    ResultFile.Close
   
    Dim TicketsFile As Scripting.TextStream
    Set TicketsFile = fso.OpenTextFile("c:\Tickets.txt")
   
    'Create the winningTickets.txt text files
    Set WinningTicketsFile = fso.CreateTextFile("c:\WinningTickets.txt")
   
    Dim sMatching As String 'String to store the matching numbers
   
    Dim iNumberCount As Long
    With TicketsFile
        While Not .AtEndOfStream
            sTicketLine = .ReadLine()
            sTicketNumbers = Split(sTicketLine, ",")
            iNumberCount = 0 'Initialise
            sMatching = ""   'Initialise
            For i = LBound(sTicketNumbers) To UBound(sTicketNumbers)
                If colResults.Exists(Trim(sTicketNumbers(i))) Then
                    sMatching = sMatching & sTicketNumbers(i) & " "
                    iNumberCount = iNumberCount + 1
                End If
            Next i
            If iNumberCount > 2 Then 'At least 3 matching numbers have been found
                WinningTicketsFile.WriteLine "Ticket " & sTicketLine & " has the " & iNumberCount & " numbers " & sMatching & "matching the winning ticket"
            End If
        Wend
        .Close
    End With
    WinningTicketsFile.Close
End Sub


To try this program create a file called c:\Result.txt with the following line:
2,6,21,34,35,49

Then create a file called c:\Tickets.txt with the following lines:
1,2,3,4,5,6
1,6,13,21,25,49
2,6,21,34,35,49
10,15,23,30,35,49
3,6,21,34,40,41
1,21,34,35,40,42
1,2,6,21,34,40,45

When run the program will create the following output in the file c:\WinningNumbers.txt:
Ticket 1,6,13,21,25,49 has the 3 numbers 6 21 49 matching the winning ticket
Ticket 2,6,21,34,35,49 has the 6 numbers 2 6 21 34 35 49 matching the winning ticket
Ticket 3,6,21,34,40,41 has the 3 numbers 6 21 34 matching the winning ticket
Ticket 1,21,34,35,40,42 has the 3 numbers 21 34 35 matching the winning ticket
Ticket 1,2,6,21,34,40,45 has the 4 numbers 2 6 21 34 matching the winning ticket

0
 

Author Comment

by:bhattar
ID: 13970639
I have Office 97 and cannot seem to run any of these programs. Do I need to upgrade?

Regards..
0
 

Author Comment

by:bhattar
ID: 13972322
Upgraded to Office XP and all works great. Thanks for everyones input much appreciated.
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month15 days, 2 hours left to enroll

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question