Advertisement
Brovashift

Untitled

May 10th, 2023 (edited)
144
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.  
  4. Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
  5.     ' Check if the node is a child node
  6.    If Node.Parent <> "" Then
  7.         ' Cancel the label edit
  8.        Cancel = True
  9.     End If
  10. End Sub
  11.  
  12. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  13.    
  14.     ' Declare variables
  15.    Dim raceCourse As String
  16.     Dim raceTime As String
  17.     Dim targetSheet As Worksheet
  18.     Dim targetRow As Long
  19.     Dim offTime As Date
  20.     Dim course As String
  21.     Dim raceName As String
  22.     Dim raceDate As Date
  23.     Dim prizeMoney As String
  24.     Dim formattedPrizeMoney As String
  25.     Dim regex As Object
  26.     Dim raceDist As String
  27.     Dim raceClass As String
  28.     Dim raceType As String
  29.     Dim going As String
  30.     Dim fieldSize As String
  31.    
  32.     ' Check if clicked node is a child node
  33.    If Node.Parent <> "" Then
  34.        
  35.         ' Get race course and race time from clicked nodes
  36.        raceCourse = Node.Parent.Text
  37.         raceTime = Node.Text
  38.        
  39.         ' Set target sheet
  40.        Set targetSheet = Worksheets(racecardSheetName)
  41.        
  42.         ' Find match in column B
  43.        On Error Resume Next
  44.         targetRow = targetSheet.Evaluate("match(timevalue(""" & raceTime & """),b:b,0)")
  45.         On Error GoTo 0
  46.        
  47.         If targetRow <> 0 Then
  48.            
  49.             ' Get race data from target row
  50.            offTime = targetSheet.Cells(targetRow, 2).Value
  51.             course = targetSheet.Cells(targetRow, 3).Value
  52.             raceName = targetSheet.Cells(targetRow, 4).Value
  53.             raceDate = DateValue(targetSheet.Cells(targetRow, 1).Value)
  54.             prizeMoney = targetSheet.Cells(targetRow, 10).Value
  55.             raceDist = targetSheet.Cells(targetRow, 5).Value
  56.             raceClass = targetSheet.Cells(targetRow, 6).Value
  57.             raceType = targetSheet.Cells(targetRow, 7).Value
  58.             going = targetSheet.Cells(targetRow, 9).Value
  59.             fieldSize = targetSheet.Cells(targetRow, 8).Value
  60.            
  61.             ' Create a regular expression object
  62.            Set regex = CreateObject("VBScript.RegExp")
  63.             With regex
  64.                 .Pattern = "\D" ' Match any non-digit character
  65.                .Global = True ' Match all occurrences
  66.            End With
  67.            
  68.             ' Remove non-numeric characters from prizeMoney
  69.            prizeMoney = regex.Replace(prizeMoney, "")
  70.             formattedPrizeMoney = "£" & Format(Val(prizeMoney), "#,##0")
  71.            
  72.             ' Display race data in labels
  73.            TimeLbl.Caption = Format(offTime, "h:mm")
  74.             CourseLbl.Caption = course
  75.             RaceNameLbl.Caption = raceName
  76.             DateLbl.Caption = Format(raceDate, "dd mmm yy")
  77.             prizeLbl.Caption = formattedPrizeMoney
  78.             distLbl.Caption = raceDist & "f"
  79.             classLbl.Caption = raceClass
  80.             raceTypeLbl = raceType
  81.             goingLbl = going
  82.             runnersLbl = fieldSize
  83.            
  84.            
  85.             ' Populate parent ListView with data from Sheet1
  86.            PopulateParentListView raceCourse, raceTime
  87.            
  88.             ' Populate child ListView with data from Sheet2
  89.            'PopulateChildListView raceTime
  90.            
  91.            
  92.            
  93.         Else
  94.             ' Display error message if no match was found
  95.            MsgBox "No race found for " & raceTime & " at " & raceCourse
  96.         End If
  97.     End If
  98.    
  99. End Sub
  100. Private Sub PopulateParentListView(ByVal raceCourseName As String, ByVal raceTime As String)
  101.     ' Clear existing items from parent ListView
  102.    ListView1.ListItems.Clear
  103.    
  104.     ' Set the target sheet
  105.    Dim targetSheet As Worksheet
  106.     Set targetSheet = Worksheets(racecardSheetName)
  107.    
  108.     ' Populate parent ListView with data from Sheet1 based on selected race time
  109.    Dim lastRow As Long
  110.     lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
  111.    
  112.     Dim i As Long
  113.     For i = 2 To lastRow
  114.         If StrComp(targetSheet.Cells(i, 3).Value, raceCourseName, vbTextCompare) = 0 _
  115.         And StrComp(targetSheet.Cells(i, 2).Value, raceTime, vbTextCompare) = 0 Then
  116.         ' Add horse names to the parent ListView
  117.        Dim listItem As MSComctlLib.listItem
  118.         Set listItem = Me.ListView1.ListItems.Add(, , targetSheet.Cells(i, 12).Value)
  119.         ' Add more subitems as needed
  120.    End If
  121.  
  122.     Next i
  123. End Sub
  124.  
  125.  
  126. Private Sub UserForm_Initialize()
  127.     ' Import racecard CSV data into a new sheet
  128.    Dim newSheet As Worksheet
  129.     Set newSheet = Workbooks("RaceCardAnalyser.xlsm").Worksheets.Add
  130.     With newSheet.QueryTables.Add(Connection:= _
  131.         "TEXT;C:\Users\Contango\Desktop\Racecard Analysis Project\Racecards\racecards.csv", Destination:=newSheet.Range("A1"))
  132.         .TextFileCommaDelimiter = True 'Set delimiter to comma
  133.        .TextFileParseType = xlDelimited
  134.         .Refresh
  135.     End With
  136.    
  137.     ' Import historical data CSV data into a new sheet
  138.    'Dim newSheet2 As Worksheet
  139.    'Set newSheet2 = Workbooks("RaceCardAnalyser.xlsm").Worksheets.Add
  140.    'With newSheet2.QueryTables.Add(Connection:= _
  141.         '"TEXT;C:\Users\Contango\Desktop\Racecard Analysis Project\Data\data.csv", Destination:=newSheet2.Range("A1"))
  142.        '.TextFileCommaDelimiter = True 'Set delimiter to comma
  143.        '.TextFileParseType = xlDelimited
  144.        '.Refresh
  145.    'End With
  146.    
  147.     ' Store the name of the new racecard sheet
  148.    racecardSheetName = newSheet.Name
  149.    
  150.     ' Store the name of the new data sheet
  151.    'dataSheetName = newSheet2.Name
  152.    
  153.     ' Create dictionary to store racecourses and times
  154.    Dim raceData As Object
  155.     Set raceData = CreateObject("Scripting.Dictionary")
  156.    
  157.     ' Loop through all rows of data
  158.    Dim currRow As Long
  159.     For currRow = 2 To newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Row
  160.         ' Get current race course and race time
  161.        Dim raceCourse As String
  162.         Dim raceTime As String
  163.         raceCourse = newSheet.Cells(currRow, 3).Value
  164.         raceTime = Format(newSheet.Cells(currRow, 2).Value, "h:mm")
  165.        
  166.         ' Add race course and race time to dictionary
  167.        If Not raceData.Exists(raceCourse) Then
  168.             raceData.Add raceCourse, New Collection
  169.         End If
  170.        
  171.         ' Add race time to collection if it doesn't already exist
  172.        Dim raceTimeCheck As Collection
  173.         Set raceTimeCheck = raceData(raceCourse)
  174.         Dim found As Boolean
  175.         found = False
  176.         Dim i As Long
  177.         For i = 1 To raceTimeCheck.Count
  178.             If raceTimeCheck(i) = raceTime Then
  179.                 found = True
  180.                 Exit For
  181.             ElseIf raceTimeCheck(i) > raceTime Then
  182.                 raceTimeCheck.Add raceTime, Before:=i
  183.                 found = True
  184.                 Exit For
  185.             End If
  186.         Next i
  187.         If Not found Then
  188.             raceTimeCheck.Add raceTime
  189.         End If
  190.     Next currRow
  191.    
  192.     ' Populate TreeView with data from dictionary
  193.    Dim raceCourses As Variant
  194.     For Each raceCourses In raceData
  195.         ' Add parent node for race course
  196.        Dim currNode As Node
  197.         Set currNode = TreeView1.Nodes.Add(, , raceCourses, raceCourses)
  198.         currNode.Tag = raceCourses
  199.        
  200.         ' Add child nodes for race times
  201.        Dim raceTimes As Variant
  202.         For Each raceTimes In raceData(raceCourses)
  203.             Set currNode = TreeView1.Nodes.Add(raceCourses, tvwChild, , raceTimes)
  204.             currNode.Tag = raceTimes
  205.         Next raceTimes
  206.     Next raceCourses
  207.    
  208.     ' Clean up
  209.    Set newSheet = Nothing
  210.     Set raceData = Nothing
  211.    
  212. End Sub
  213.  
  214. Private Sub UserForm_Terminate()
  215.  
  216.     ' NOTES: Remove the sheet created when the form was initialized
  217.    Application.DisplayAlerts = False 'Suppress alert message
  218.    Workbooks("RaceCardAnalyser.xlsm").Sheets(racecardSheetName).Delete
  219.    
  220.     'Workbooks("RaceCardAnalyser.xlsm").Sheets(dataSheetName).Delete
  221.    Application.DisplayAlerts = True
  222.    
  223. End Sub
  224.  
  225.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement