Advertisement
Brovashift

Untitled

Apr 30th, 2023 (edited)
166
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Private targetSheetName As String
  2.  
  3. Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
  4.     ' Check if the node is a child node
  5.    If Node.Parent <> "" Then
  6.         ' Cancel the label edit
  7.        Cancel = True
  8.     End If
  9. End Sub
  10.  
  11. Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  12.    
  13.     ' Declare variables
  14.    Dim raceCourse As String
  15.     Dim raceTime As String
  16.     Dim targetSheet As Worksheet
  17.     Dim targetRow As Long
  18.     Dim offTime As Date
  19.     Dim course As String
  20.     Dim raceType As String
  21.     Dim raceDate As Date
  22.    
  23.     ' Check if clicked node is a child node
  24.    If Node.Parent <> "" Then
  25.        
  26.         ' Get race course and race time from clicked nodes
  27.        raceCourse = Node.Parent.Text
  28.         raceTime = Node.Text
  29.         Debug.Print "raceTime = " & raceTime
  30.        
  31.         ' Set target sheet
  32.        Set targetSheet = Worksheets(targetSheetName)
  33.        
  34.         ' Find match in column B
  35.        'On Error Resume Next
  36.        targetRow = Application.WorksheetFunction.Match(CDbl(TimeValue(raceTime)), targetSheet.Range("B:B"), 0)
  37.         Debug.Print targetRow
  38.         'On Error GoTo 0
  39.        
  40.         If targetRow <> 0 Then
  41.            
  42.             ' Get race data from target row
  43.            offTime = targetSheet.Cells(targetRow, 2).Value
  44.             Debug.Print offTime
  45.             course = targetSheet.Cells(targetRow, 3).Value
  46.             Debug.Print course
  47.             raceType = targetSheet.Cells(targetRow, 4).Value
  48.             Debug.Print raceType
  49.             raceDate = DateValue(targetSheet.Cells(targetRow, 1).Value)
  50.             Debug.Print raceDate
  51.            
  52.             ' Display race data in labels
  53.            TimeLbl.Caption = Format(offTime, "hh:mm")
  54.             CourseLbl.Caption = course
  55.             RaceTypeLbl.Caption = raceType
  56.             DateLbl.Caption = Format(raceDate, "mm/dd/yyyy")
  57.            
  58.         Else
  59.             ' Display error message if no match was found
  60.            MsgBox "No race found for " & raceTime & " at " & raceCourse
  61.         End If
  62.     End If
  63.    
  64. End Sub
  65.  
  66. Private Sub UserForm_Initialize()
  67.     ' Import CSV data into a new sheet
  68.    Dim newSheet As Worksheet
  69.     Set newSheet = Workbooks("RaceCardAnalyser.xlsm").Worksheets.Add
  70.     With newSheet.QueryTables.Add(Connection:= _
  71.         "TEXT;C:\Users\Contango\Desktop\Racecard Analysis Project\Racecards\racecards.csv", Destination:=newSheet.Range("A1"))
  72.         .TextFileCommaDelimiter = True 'Set delimiter to comma
  73.        .TextFileParseType = xlDelimited
  74.         .Refresh
  75.     End With
  76.    
  77.     ' Store the name of the new sheet
  78.    targetSheetName = newSheet.Name
  79.    
  80.     ' Create dictionary to store racecourses and times
  81.    Dim raceData As Object
  82.     Set raceData = CreateObject("Scripting.Dictionary")
  83.    
  84.     ' Loop through all rows of data
  85.    Dim currRow As Long
  86.     For currRow = 2 To newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Row
  87.         ' Get current race course and race time
  88.        Dim raceCourse As String
  89.         Dim raceTime As String
  90.         raceCourse = newSheet.Cells(currRow, 3).Value
  91.         raceTime = Format(newSheet.Cells(currRow, 2).Value, "hh:mm")
  92.        
  93.         ' Add race course and race time to dictionary
  94.        If Not raceData.Exists(raceCourse) Then
  95.             raceData.Add raceCourse, New Collection
  96.         End If
  97.        
  98.         ' Add race time to collection if it doesn't already exist
  99.        Dim raceTimeCheck As Collection
  100.         Set raceTimeCheck = raceData(raceCourse)
  101.         Dim found As Boolean
  102.         found = False
  103.         Dim i As Long
  104.         For i = 1 To raceTimeCheck.Count
  105.             If raceTimeCheck(i) = raceTime Then
  106.                 found = True
  107.                 Exit For
  108.             ElseIf raceTimeCheck(i) > raceTime Then
  109.                 raceTimeCheck.Add raceTime, Before:=i
  110.                 found = True
  111.                 Exit For
  112.             End If
  113.         Next i
  114.         If Not found Then
  115.             raceTimeCheck.Add raceTime
  116.         End If
  117.     Next currRow
  118.    
  119.     ' Populate TreeView with data from dictionary
  120.    Dim raceCourses As Variant
  121.     For Each raceCourses In raceData
  122.         ' Add parent node for race course
  123.        Dim currNode As Node
  124.         Set currNode = TreeView1.Nodes.Add(, , raceCourses, raceCourses)
  125.         currNode.Tag = raceCourses
  126.        
  127.         ' Add child nodes for race times
  128.        Dim raceTimes As Variant
  129.         For Each raceTimes In raceData(raceCourses)
  130.             Set currNode = TreeView1.Nodes.Add(raceCourses, tvwChild, , raceTimes)
  131.             currNode.Tag = raceTimes
  132.         Next raceTimes
  133.     Next raceCourses
  134.    
  135.     ' Clean up
  136.    Set newSheet = Nothing
  137.     Set raceData = Nothing
  138.    
  139. End Sub
  140.  
  141. Private Sub UserForm_Terminate()
  142.  
  143.     ' NOTES: Remove the sheet created when the form was initialized
  144.    Application.DisplayAlerts = False 'Suppress alert message
  145.    Workbooks("RaceCardAnalyser.xlsm").Sheets(targetSheetName).Delete
  146.     Application.DisplayAlerts = True
  147.    
  148. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement