Advertisement
Brovashift

Untitled

May 21st, 2023
598
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Private racecardSheetName As String
  2. Private dataSheetName As String
  3. Private horseData As Object
  4. Dim originalData As Collection
  5.  
  6. Private Sub ComboBox1_Change()
  7.     Dim selectedValue As String
  8.     Dim item As Variant
  9.    
  10.     selectedValue = ComboBox1.value
  11.    
  12.     ' Preserve the "All" option in the ComboBox
  13.    If selectedValue = "All" Then
  14.         ' Clear existing items from ListView2
  15.        ListView2.ListItems.Clear
  16.         PopulateChildListView horseData
  17.         ' Add all items from originalData to ListView2
  18.        'For Each item In originalData
  19.            'ListView2.ListItems.Add , , item.Text ' Add the item to ListView2
  20.            ' Add more subitems as needed
  21.        'Next item
  22.    Else
  23.         ' Clear existing items from ListView2
  24.        ListView2.ListItems.Clear
  25.        
  26.         ' Filter the data based on the selected value
  27.       For Each item In originalData
  28.             If item.ListSubItems(4).Text = selectedValue Then
  29.                 Dim newItem As MSComctlLib.listItem
  30.                 Set newItem = ListView2.ListItems.Add(, , item.Text) ' Add the item to ListView2
  31.                
  32.                 ' Add more subitems as needed
  33.                newItem.ListSubItems.Add , , item.ListSubItems(1).Text ' Add subitem for column 2
  34.                newItem.ListSubItems.Add , , item.ListSubItems(2).Text ' Add subitem for column 3
  35.                newItem.ListSubItems.Add , , item.ListSubItems(3).Text ' Add subitem for column 4
  36.                newItem.ListSubItems.Add , , item.ListSubItems(4).Text ' Add subitem for column 5
  37.                newItem.ListSubItems.Add , , item.ListSubItems(5).Text ' Add subitem for column 6
  38.                newItem.ListSubItems.Add , , item.ListSubItems(6).Text ' Add subitem for column 7
  39.                newItem.ListSubItems.Add , , item.ListSubItems(7).Text ' Add subitem for column 8
  40.                newItem.ListSubItems.Add , , item.ListSubItems(8).Text ' Add subitem for column 9
  41.                newItem.ListSubItems.Add , , item.ListSubItems(9).Text ' Add subitem for column 10
  42.                newItem.ListSubItems.Add , , item.ListSubItems(10).Text ' Add subitem for column 11
  43.                newItem.ListSubItems.Add , , item.ListSubItems(11).Text ' Add subitem for column 12
  44.                newItem.ListSubItems.Add , , item.ListSubItems(12).Text ' Add subitem for column 13
  45.                newItem.ListSubItems.Add , , item.ListSubItems(13).Text ' Add subitem for column 14
  46.                newItem.ListSubItems.Add , , item.ListSubItems(14).Text ' Add subitem for column 15
  47.                newItem.ListSubItems.Add , , item.ListSubItems(15).Text ' Add subitem for column 16
  48.                newItem.ListSubItems.Add , , item.ListSubItems(16).Text ' Add subitem for column 17
  49.                newItem.ListSubItems.Add , , item.ListSubItems(17).Text ' Add subitem for column 18
  50.                newItem.ListSubItems.Add , , item.ListSubItems(18).Text ' Add subitem for column 19
  51.                newItem.ListSubItems.Add , , item.ListSubItems(19).Text ' Add subitem for column 20
  52.                ' Add more subitems for additional columns
  53.                
  54.                 ' ...
  55.            End If
  56.         Next item
  57.     End If
  58. End Sub
  59.  
  60. Private Sub PopulateComboBox()
  61.  
  62.     ComboBox1.Clear
  63.     ComboBox1.AddItem "All" ' Add "All" value at the top
  64.    
  65.     Dim item As listItem
  66.     Dim columnValue As String
  67.     Dim itemExists As Boolean
  68.    
  69.     ' Assuming the column you want to extract values from is column 5 (index 4)
  70.    For Each item In ListView2.ListItems
  71.         columnValue = item.ListSubItems(4).Text
  72.        
  73.         ' Check if the value already exists in ComboBox
  74.        itemExists = False
  75.         For i = 0 To ComboBox1.ListCount - 1
  76.             If ComboBox1.List(i) = columnValue Then
  77.                 itemExists = True
  78.                 Exit For
  79.             End If
  80.         Next i
  81.        
  82.         ' Add the value to ComboBox if it doesn't exist
  83.        If Not itemExists Then
  84.             ComboBox1.AddItem columnValue
  85.         End If
  86.     Next item
  87. End Sub
  88.  
  89. Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
  90.     ' Check if the edit is being performed on the first column (index 1) of ListView1
  91.    If ListView1.ColumnHeaders(1).Index = 1 Then
  92.         ' Cancel the label edit event
  93.        Cancel = True
  94.     End If
  95. End Sub
  96.  
  97. Private Sub ListView2_BeforeLabelEdit(Cancel As Integer)
  98.     ' Check if the edit is being performed on the first column (index 1) of ListView2
  99.    If ListView2.ColumnHeaders(1).Index = 1 Then
  100.         ' Cancel the label edit event
  101.        Cancel = True
  102.     End If
  103. End Sub
  104.  
  105. Private Sub ListView1_ItemClick(ByVal item As MSComctlLib.listItem)
  106.  
  107.     PopulateComboBox
  108.     ' Get the horse name from the clicked item
  109.    Dim horseName As String
  110.     horseName = item.Text ' Assuming horse name is stored in the first column
  111.    
  112.     ' Populate child ListView with data from Sheet2
  113.    PopulateChildListView horseName
  114.  
  115. End Sub
  116.  
  117. Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
  118.     On Error Resume Next
  119.    
  120.     ' Get the currently edited node
  121.    Dim editedNode As Node
  122.     Set editedNode = TreeView1.SelectedItem
  123.    
  124.     ' Check if the edited node is a parent or child node
  125.    If Err.Number <> 0 Then
  126.         ' Error occurred, cancel the label edit
  127.        Cancel = True
  128.     ElseIf editedNode.Child <> "" Or editedNode.Parent <> "" Then
  129.         ' Cancel the label edit
  130.        Cancel = True
  131.     End If
  132.    
  133.     On Error GoTo 0
  134. End Sub
  135.  
  136. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  137.    
  138.     ' Clear existing items from parent ListView
  139.    ListView2.ListItems.Clear
  140.    
  141.     ' Declare variables
  142.    Dim raceCourse As String
  143.     Dim raceTime As String
  144.     Dim targetSheet As Worksheet
  145.     Dim targetRow As Long
  146.     Dim offTime As Date
  147.     Dim course As String
  148.     Dim raceName As String
  149.     Dim raceDate As Date
  150.     Dim prizeMoney As String
  151.     Dim formattedPrizeMoney As String
  152.     Dim regex As Object
  153.     Dim raceDist As String
  154.     Dim raceClass As String
  155.     Dim raceType As String
  156.     Dim going As String
  157.     Dim fieldSize As String
  158.    
  159.     ' Check if clicked node is a child node
  160.    If Not Node.Parent Is Nothing Then
  161.        
  162.         ' Get race course and race time from clicked nodes
  163.        raceCourse = Node.Parent.Text
  164.         raceTime = Node.Text
  165.        
  166.         ' Set target sheet
  167.        Set targetSheet = Worksheets(racecardSheetName)
  168.        
  169.         ' Find match in column B
  170.        On Error Resume Next
  171.         targetRow = targetSheet.Evaluate("match(timevalue(""" & raceTime & """),b:b,0)")
  172.         On Error GoTo 0
  173.        
  174.         If targetRow <> 0 Then
  175.            
  176.             ' Get race data from target row
  177.            offTime = targetSheet.Cells(targetRow, 2).value
  178.             course = targetSheet.Cells(targetRow, 3).value
  179.             raceName = targetSheet.Cells(targetRow, 4).value
  180.             raceDate = dateValue(targetSheet.Cells(targetRow, 1).value)
  181.             prizeMoney = targetSheet.Cells(targetRow, 10).value
  182.             raceDist = targetSheet.Cells(targetRow, 5).value
  183.             raceClass = targetSheet.Cells(targetRow, 6).value
  184.             raceType = targetSheet.Cells(targetRow, 7).value
  185.             going = targetSheet.Cells(targetRow, 9).value
  186.             fieldSize = targetSheet.Cells(targetRow, 8).value
  187.            
  188.             ' Create a regular expression object
  189.            Set regex = CreateObject("VBScript.RegExp")
  190.             With regex
  191.                 .Pattern = "\D" ' Match any non-digit character
  192.                .Global = True ' Match all occurrences
  193.            End With
  194.            
  195.             ' Remove non-numeric characters from prizeMoney
  196.            prizeMoney = regex.Replace(prizeMoney, "")
  197.             formattedPrizeMoney = "£" & Format(Val(prizeMoney), "#,##0")
  198.            
  199.             ' Display race data in labels
  200.            TimeLbl.Caption = Format(offTime, "h:mm")
  201.             CourseLbl.Caption = course
  202.             RaceNameLbl.Caption = raceName
  203.             DateLbl.Caption = Format(raceDate, "dd mmm yy")
  204.             prizeLbl.Caption = formattedPrizeMoney
  205.             distLbl.Caption = raceDist & "f"
  206.             classLbl.Caption = raceClass
  207.             raceTypeLbl = raceType
  208.             goingLbl = going
  209.             runnersLbl = fieldSize
  210.            
  211.            
  212.             ' Populate parent ListView with data from Sheet1
  213.            PopulateParentListView raceCourse, raceTime
  214.            
  215.            
  216.         Else
  217.             ' Display error message if no match was found
  218.            MsgBox "No race found for " & raceTime & " at " & raceCourse
  219.         End If
  220.  
  221.     End If
  222.    
  223. End Sub
  224. Private Sub PopulateParentListView(ByVal raceCourseName As String, ByVal raceTime As String)
  225.     ' Clear existing items from parent ListView
  226.    ListView1.ListItems.Clear
  227.    
  228.     ' Set the target sheet
  229.    Dim targetSheet As Worksheet
  230.     Set targetSheet = Worksheets(racecardSheetName)
  231.    
  232.     ' Create dictionary to store horse names and row numbers
  233.    'Dim horseData As Object
  234.    Set horseData = CreateObject("Scripting.Dictionary")
  235.    
  236.     ' Populate horse data dictionary based on raceCourseName and raceTime
  237.    Dim lastRow As Long
  238.     lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
  239.    
  240.     Dim i As Long
  241.     For i = 2 To lastRow
  242.         Dim key As String
  243.         key = raceCourseName & "_" & raceTime
  244.        
  245.         If Trim(targetSheet.Cells(i, 3).value) = Trim(raceCourseName) And Format(targetSheet.Cells(i, 2).value, "h:mm") = Format(timeValue(raceTime), "h:mm") Then
  246.             Dim horseName As String
  247.             horseName = targetSheet.Cells(i, 12).value
  248.            
  249.             ' Add horse name and row number to horse data dictionary
  250.            horseData(horseName) = i
  251.         End If
  252.     Next i
  253.    
  254.     ' Populate parent ListView using horse data dictionary
  255.    Dim horseNameKey As Variant
  256.     For Each horseNameKey In horseData.Keys
  257.         Dim rowIndex As Long
  258.         rowIndex = horseData(horseNameKey)
  259.        
  260.         Dim listItem As MSComctlLib.listItem
  261.         Set listItem = ListView1.ListItems.Add(, , horseNameKey) ' Column 1
  262.        
  263.         ' Add additional subitems
  264.        listItem.SubItems(1) = targetSheet.Cells(rowIndex, 28).value ' Column 2
  265.        listItem.SubItems(2) = targetSheet.Cells(rowIndex, 11).value ' Column 3
  266.        listItem.SubItems(3) = targetSheet.Cells(rowIndex, 22).value ' Column 4
  267.        listItem.SubItems(4) = targetSheet.Cells(rowIndex, 23).value ' Column 5
  268.        listItem.SubItems(5) = targetSheet.Cells(rowIndex, 24).value ' Column 6
  269.        listItem.SubItems(6) = targetSheet.Cells(rowIndex, 25).value ' Column 7
  270.        listItem.SubItems(7) = targetSheet.Cells(rowIndex, 26).value ' Column 8
  271.        listItem.SubItems(8) = targetSheet.Cells(rowIndex, 21).value ' Column 9
  272.        listItem.SubItems(9) = targetSheet.Cells(rowIndex, 27).value ' Column 10
  273.        listItem.SubItems(10) = targetSheet.Cells(rowIndex, 17).value ' Column 11
  274.        listItem.SubItems(11) = targetSheet.Cells(rowIndex, 19).value ' Column 12
  275.        ' Add more subitems as needed
  276.        
  277.         ' Additional settings optional data
  278.        listItem.SubItems(12) = targetSheet.Cells(rowIndex, 13).value ' Column 13
  279.        listItem.SubItems(13) = targetSheet.Cells(rowIndex, 15).value ' Column 14
  280.        listItem.SubItems(14) = targetSheet.Cells(rowIndex, 16).value ' Column 15
  281.        listItem.SubItems(15) = targetSheet.Cells(rowIndex, 18).value ' Column 16
  282.        listItem.SubItems(16) = targetSheet.Cells(rowIndex, 20).value ' Column 17
  283.        
  284.     Next horseNameKey
  285.    
  286.     PopulateChildListView horseData '************************************************************************************************
  287.    
  288. End Sub
  289. Sub PopulateChildListView(Optional ByVal horseName As Variant, Optional ByVal horseData As Object)
  290.     ' Clear existing items from child ListView
  291.    ListView2.ListItems.Clear
  292.    
  293.     ' Clear the originalData collection
  294.    Set originalData = New Collection
  295.    
  296.     ' Set the target sheet (Sheet2)
  297.    Dim targetSheet As Worksheet
  298.     Set targetSheet = Worksheets(dataSheetName) ' Replace "Sheet2" with the actual name of the sheet
  299.    
  300.     ' Find the last row in Sheet2
  301.    Dim lastRow As Long
  302.     lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
  303.    
  304.     ' Flag variable to indicate if any matching data is found
  305.    Dim matchFound As Boolean
  306.     matchFound = False
  307.    
  308.     If TypeName(horseName) = "String" Then
  309.         ' Loop through the rows in Sheet2 and populate the ChildListView with matching data
  310.        Dim i As Long
  311.         For i = 2 To lastRow ' Assuming the data starts from row 2
  312.            Dim horseNameSheet2 As String
  313.             horseNameSheet2 = targetSheet.Cells(i, 22).value ' Assuming the horse name is in the first column of Sheet2
  314.            
  315.             ' Remove the region letters from the horse name in Sheet2
  316.            Dim regionPos As Integer
  317.             regionPos = InStr(horseNameSheet2, "(")
  318.             If regionPos > 0 Then
  319.                 horseNameSheet2 = Trim(left(horseNameSheet2, regionPos - 1))
  320.             End If
  321.            
  322.             ' Compare the horse names
  323.            If StrComp(horseNameSheet2, horseName, vbTextCompare) = 0 Then
  324.                 Dim listItem As MSComctlLib.listItem
  325.                 Set listItem = ListView2.ListItems.Add(, , targetSheet.Cells(i, 1).value) ' Assuming the data you want to display is in the second column of Sheet2
  326.                
  327.                 ' Call the subroutine to add subitems
  328.                AddListViewSubItems listItem, targetSheet, i
  329.                
  330.                 ' Add the item to the originalData collection
  331.                originalData.Add listItem
  332.                
  333.                 matchFound = True ' Set the flag to indicate a match was found
  334.            End If
  335.         Next i
  336.     ElseIf TypeName(horseName) = "Dictionary" Then
  337.         ' Loop through the horse names in the dictionary and retrieve matching rows from Sheet2
  338.        Dim horseNameKey As Variant
  339.         For Each horseNameKey In horseName.Keys
  340.             Dim horseNameValue As String
  341.             horseNameValue = CStr(horseNameKey)
  342.            
  343.             ' Loop through the rows in Sheet2 and populate the ChildListView with matching data
  344.            Dim x As Long
  345.             For x = 2 To lastRow ' Assuming the data starts from row 2
  346.                Dim horseNameSheet22 As String
  347.                 horseNameSheet22 = targetSheet.Cells(x, 22).value ' Assuming the horse name is in the 22nd column of Sheet2
  348.                
  349.                 ' Remove the region letters from the horse name in Sheet2
  350.                Dim regionPos2 As Integer
  351.                 regionPos2 = InStr(horseNameSheet22, "(")
  352.                 If regionPos2 > 0 Then
  353.                     horseNameSheet22 = Trim(left(horseNameSheet22, regionPos2 - 1))
  354.                 End If
  355.                
  356.                 ' Compare the horse names
  357.                If StrComp(horseNameSheet22, horseNameValue, vbTextCompare) = 0 Then
  358.                     Dim listItem2 As MSComctlLib.listItem
  359.                     Set listItem2 = ListView2.ListItems.Add(, , targetSheet.Cells(x, 1).value) ' Assuming the data you want to display is in the first column of Sheet2
  360.                    
  361.                     ' Call the subroutine to add subitems
  362.                    AddListViewSubItems listItem2, targetSheet, x
  363.                    
  364.                      ' Add the item to the originalData collection
  365.                    originalData.Add listItem2
  366.                    
  367.                     matchFound = True ' Set the flag to indicate a match was found
  368.                End If
  369.             Next x
  370.         Next horseNameKey
  371.     End If
  372.    
  373.     ' Check if any matching data was found for the horse name(s)
  374.    If Not matchFound Then
  375.         MsgBox "No matching data found for horse name: " & horseName
  376.     End If
  377.    
  378.     PopulateComboBox
  379.    
  380. End Sub
  381.  
  382. Private Sub AddListViewSubItems(ByVal listItem As MSComctlLib.listItem, ByVal targetSheet As Worksheet, ByVal i As Long)
  383.     ' Add subitems to the ListView2
  384.  
  385.     listItem.SubItems(1) = targetSheet.Cells(i, 22).value ' Column 1
  386.    listItem.SubItems(2) = targetSheet.Cells(i, 3).value ' Column 2
  387.    listItem.SubItems(3) = targetSheet.Cells(i, 5).value ' Column 3
  388.    listItem.SubItems(4) = targetSheet.Cells(i, 13).value ' Column 4
  389.    listItem.SubItems(5) = targetSheet.Cells(i, 15).value ' Column 5
  390.  
  391.     Dim unformattedTime As String
  392.     unformattedTime = targetSheet.Cells(i, 27).Text ' Assuming the time value is stored as text in the cell
  393.  
  394.     ' Assign the unformatted time to the SubItems property
  395.    listItem.SubItems(6) = unformattedTime ' Column 7
  396.  
  397.     listItem.SubItems(7) = targetSheet.Cells(i, 18).value ' Column 8
  398.    listItem.SubItems(8) = targetSheet.Cells(i, 16).value ' Column 9
  399.    listItem.SubItems(9) = targetSheet.Cells(i, 21).value ' Column 10
  400.    listItem.SubItems(10) = targetSheet.Cells(i, 7).value ' Column 12
  401.    listItem.SubItems(11) = targetSheet.Cells(i, 25).value ' Column 13
  402.    listItem.SubItems(12) = targetSheet.Cells(i, 33).value ' Column 14
  403.    listItem.SubItems(13) = targetSheet.Cells(i, 34).value ' Column 15
  404.    listItem.SubItems(14) = targetSheet.Cells(i, 26).value ' Column 16
  405.    listItem.SubItems(15) = targetSheet.Cells(i, 19).value ' Column 17
  406.    listItem.SubItems(16) = targetSheet.Cells(i, 17).value ' Column 18
  407.    listItem.SubItems(17) = targetSheet.Cells(i, 30).value ' Column 19
  408.    listItem.SubItems(18) = targetSheet.Cells(i, 32).value ' Column 20
  409.    listItem.SubItems(19) = targetSheet.Cells(i, 39).value ' Column 3
  410.    ' Add more subitems as needed
  411.    
  412.    
  413.    
  414. End Sub
  415.  
  416.  
  417. Private Sub CreateListView1ColumnHeaders()
  418.  
  419.     ' Add column headers
  420.    ListView1.ColumnHeaders.Clear
  421.     ListView1.ColumnHeaders.Add , , "Horse Name" ' Column 1
  422.    ListView1.ColumnHeaders.Add , , "Form" ' Column 2
  423.    ListView1.ColumnHeaders.Add , , "Age" ' Column 3
  424.    ListView1.ColumnHeaders.Add , , "HG" ' Column 4
  425.    ListView1.ColumnHeaders.Add , , "WGT" ' Column 5
  426.    ListView1.ColumnHeaders.Add , , "OR" ' Column 6
  427.    ListView1.ColumnHeaders.Add , , "RPR" ' Column 7
  428.    ListView1.ColumnHeaders.Add , , "TS" ' Column 8
  429.    ListView1.ColumnHeaders.Add , , "Draw" ' Column 9
  430.    ListView1.ColumnHeaders.Add , , "Jockey" ' Column 10
  431.    ListView1.ColumnHeaders.Add , , "Trainer" ' Column 11
  432.    ListView1.ColumnHeaders.Add , , "Comments" ' Column 12
  433.    ' Add more column headers as needed
  434.    
  435.     'Optional settings columns
  436.    ListView1.ColumnHeaders.Add , , "Sex" ' Column 13
  437.    ListView1.ColumnHeaders.Add , , "Dam" ' Column 14
  438.    ListView1.ColumnHeaders.Add , , "Sire" ' Column 15
  439.    ListView1.ColumnHeaders.Add , , "Owner" ' Column 16
  440.    ListView1.ColumnHeaders.Add , , "Spotlight" ' Column 17
  441.    
  442.     Me.ListView1.Gridlines = True
  443.  
  444. End Sub
  445.  
  446. Private Sub CreateListView2ColumnHeaders()
  447.    
  448.     ' Add column headers*******************************************************************************
  449.    ListView2.ColumnHeaders.Clear
  450.     ListView2.ColumnHeaders.Add , , "Date" ' Column 1
  451.    ListView2.ColumnHeaders.Add , , "Name" ' Column 2
  452.    ListView2.ColumnHeaders.Add , , "Course" ' Column 3
  453.    ListView2.ColumnHeaders.Add , , "Race Type" ' Column 4
  454.    ListView2.ColumnHeaders.Add , , "Distance" ' Column 5
  455.    ListView2.ColumnHeaders.Add , , "Going" ' Column 6
  456.    ListView2.ColumnHeaders.Add , , "Time" ' Column 7
  457.    ListView2.ColumnHeaders.Add , , "Position" ' Column 8
  458.    ListView2.ColumnHeaders.Add , , "Runners" ' Column 9
  459.    ListView2.ColumnHeaders.Add , , "BTN" ' Column 10
  460.    ListView2.ColumnHeaders.Add , , "Class" ' Column 11
  461.    ListView2.ColumnHeaders.Add , , "WGT" ' Column 12
  462.    ListView2.ColumnHeaders.Add , , "OR" ' Column 13
  463.    ListView2.ColumnHeaders.Add , , "RPR" ' Column 14
  464.    ListView2.ColumnHeaders.Add , , "HG" ' Column 15
  465.    ListView2.ColumnHeaders.Add , , "Draw" ' Column 16
  466.    ListView2.ColumnHeaders.Add , , "No." ' Column 17
  467.    ListView2.ColumnHeaders.Add , , "Jockey" ' Column 18
  468.    ListView2.ColumnHeaders.Add , , "Prize" ' Column 19
  469.    ListView2.ColumnHeaders.Add , , "Comments" ' Column 20
  470.    
  471.     Me.ListView1.Gridlines = True
  472. End Sub
  473. Private Sub UserForm_Initialize()
  474.     ' Import racecard CSV data into a new sheet
  475.    Dim newSheet As Worksheet
  476.     Set newSheet = Workbooks("RaceCardAnalyser.xlsm").Worksheets.Add
  477.     With newSheet.QueryTables.Add(Connection:= _
  478.         "TEXT;D:\Racecard Analysis Project\Racecards\racecards.csv", Destination:=newSheet.Range("A1"))
  479.         .TextFileCommaDelimiter = True 'Set delimiter to comma
  480.        .TextFileParseType = xlDelimited
  481.         .Refresh
  482.     End With
  483.    
  484.     ' Import historical data CSV data into a new sheet
  485.    Dim newSheet2 As Worksheet
  486.     Set newSheet2 = Workbooks("RaceCardAnalyser.xlsm").Worksheets.Add
  487.     With newSheet2.QueryTables.Add(Connection:= _
  488.         "TEXT;D:\Racecard Analysis Project\Data\data.csv", Destination:=newSheet2.Range("A1"))
  489.         .TextFileCommaDelimiter = True 'Set delimiter to comma
  490.        .TextFileParseType = xlDelimited
  491.         .Refresh
  492.     End With
  493.    
  494.     CreateListView1ColumnHeaders
  495.     CreateListView2ColumnHeaders
  496.    
  497.     ' Store the name of the new racecard sheet
  498.    racecardSheetName = newSheet.Name
  499.    
  500.     ' Store the name of the new data sheet
  501.    dataSheetName = newSheet2.Name
  502.    
  503.     ' Create dictionary to store racecourses and times
  504.    Dim raceData As Object
  505.     Set raceData = CreateObject("Scripting.Dictionary")
  506.    
  507.     ' Loop through all rows of data
  508.    Dim currRow As Long
  509.     For currRow = 2 To newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Row
  510.         ' Get current race course and race time AND horse name
  511.        Dim raceCourse As String
  512.         Dim raceTime As String
  513.         Dim horseName As String
  514.        
  515.         raceCourse = newSheet.Cells(currRow, 3).value
  516.         raceTime = Format(newSheet.Cells(currRow, 2).value, "h:mm")
  517.         horseName = newSheet.Cells(currRow, 12).value
  518.        
  519.         ' Add race course and race time to dictionary AND horse name
  520.        If Not raceData.Exists(raceCourse) Then
  521.             raceData.Add raceCourse, New Collection
  522.         End If
  523.        
  524.         ' Add race time to collection if it doesn't already exist
  525.        Dim raceTimeCheck As Collection
  526.         Set raceTimeCheck = raceData(raceCourse)
  527.         Dim found As Boolean
  528.         found = False
  529.         Dim i As Long
  530.         For i = 1 To raceTimeCheck.Count
  531.             If raceTimeCheck(i) = raceTime Then
  532.                 found = True
  533.                 Exit For
  534.             ElseIf raceTimeCheck(i) > raceTime Then
  535.                 raceTimeCheck.Add raceTime, Before:=i
  536.                 found = True
  537.                 Exit For
  538.             End If
  539.         Next i
  540.         If Not found Then
  541.             raceTimeCheck.Add raceTime
  542.         End If
  543.        
  544.     Next currRow
  545.    
  546.     ' Populate TreeView with data from dictionary
  547.    Dim raceCourses As Variant
  548.     For Each raceCourses In raceData
  549.         ' Add parent node for race course
  550.        Dim currNode As Node
  551.         Set currNode = TreeView1.Nodes.Add(, , raceCourses, raceCourses)
  552.         currNode.Tag = raceCourses
  553.        
  554.         ' Add child nodes for race times
  555.        Dim raceTimes As Variant
  556.         For Each raceTimes In raceData(raceCourses)
  557.             Set currNode = TreeView1.Nodes.Add(raceCourses, tvwChild, , raceTimes)
  558.             currNode.Tag = raceTimes
  559.         Next raceTimes
  560.     Next raceCourses
  561.    
  562.     ' Clean up
  563.    Set newSheet = Nothing
  564.     Set raceData = Nothing
  565.    
  566. End Sub
  567.  
  568. Private Sub UserForm_Terminate()
  569.  
  570.     ' NOTES: Remove the sheet created when the form was initialized
  571.    Application.DisplayAlerts = False 'Suppress alert message
  572.    Workbooks("RaceCardAnalyser.xlsm").Sheets(racecardSheetName).Delete
  573.    
  574.     Workbooks("RaceCardAnalyser.xlsm").Sheets(dataSheetName).Delete
  575.     Application.DisplayAlerts = True
  576.    
  577. End Sub
  578.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement