Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Private targetSheetName As String
- Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
- ' Check if the node is a child node
- If Node.Parent <> "" Then
- ' Cancel the label edit
- Cancel = True
- End If
- End Sub
- Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
- ' Declare variables
- Dim raceCourse As String
- Dim raceTime As String
- Dim targetSheet As Worksheet
- Dim targetRow As Long
- Dim offTime As Date
- Dim course As String
- Dim raceName As String
- Dim raceDate As Date
- Dim prizeMoney As String
- Dim formattedPrizeMoney As String
- Dim regex As Object
- Dim raceDist As String
- Dim raceClass As String
- Dim raceType As String
- Dim going As String
- Dim fieldSize As String
- ' Check if clicked node is a child node
- If Node.Parent <> "" Then
- ' Get race course and race time from clicked nodes
- raceCourse = Node.Parent.Text
- raceTime = Node.Text
- ' Set target sheet
- Set targetSheet = Worksheets(targetSheetName)
- ' Find match in column B
- On Error Resume Next
- targetRow = targetSheet.Evaluate("match(timevalue(""" & raceTime & """),b:b,0)")
- On Error GoTo 0
- If targetRow <> 0 Then
- ' Get race data from target row
- offTime = targetSheet.Cells(targetRow, 2).Value
- course = targetSheet.Cells(targetRow, 3).Value
- raceName = targetSheet.Cells(targetRow, 4).Value
- raceDate = DateValue(targetSheet.Cells(targetRow, 1).Value)
- prizeMoney = targetSheet.Cells(targetRow, 10).Value
- raceDist = targetSheet.Cells(targetRow, 5).Value
- raceClass = targetSheet.Cells(targetRow, 6).Value
- raceType = targetSheet.Cells(targetRow, 7).Value
- going = targetSheet.Cells(targetRow, 9).Value
- fieldSize = targetSheet.Cells(targetRow, 8).Value
- ' Create a regular expression object
- Set regex = CreateObject("VBScript.RegExp")
- With regex
- .Pattern = "\D" ' Match any non-digit character
- .Global = True ' Match all occurrences
- End With
- ' Remove non-numeric characters from prizeMoney
- prizeMoney = regex.Replace(prizeMoney, "")
- formattedPrizeMoney = "£" & Format(Val(prizeMoney), "#,##0")
- ' Display race data in labels
- TimeLbl.Caption = Format(offTime, "h:mm")
- CourseLbl.Caption = course
- RaceNameLbl.Caption = raceName
- DateLbl.Caption = Format(raceDate, "dd mmm yy")
- prizeLbl.Caption = formattedPrizeMoney
- distLbl.Caption = raceDist & "f"
- classLbl.Caption = raceClass
- raceTypeLbl = raceType
- goingLbl = going
- runnersLbl = fieldSize
- Else
- ' Display error message if no match was found
- MsgBox "No race found for " & raceTime & " at " & raceCourse
- End If
- End If
- End Sub
- Private Sub UserForm_Initialize()
- ' Import CSV data into a new sheet
- Dim newSheet As Worksheet
- Set newSheet = Workbooks("RaceCardAnalyser.xlsm").Worksheets.Add
- With newSheet.QueryTables.Add(Connection:= _
- "TEXT;C:\Users\Contango\Desktop\Racecard Analysis Project\Racecards\racecards.csv", Destination:=newSheet.Range("A1"))
- .TextFileCommaDelimiter = True 'Set delimiter to comma
- .TextFileParseType = xlDelimited
- .Refresh
- End With
- ' Store the name of the new sheet
- targetSheetName = newSheet.Name
- ' Create dictionary to store racecourses and times
- Dim raceData As Object
- Set raceData = CreateObject("Scripting.Dictionary")
- ' Loop through all rows of data
- Dim currRow As Long
- For currRow = 2 To newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Row
- ' Get current race course and race time
- Dim raceCourse As String
- Dim raceTime As String
- raceCourse = newSheet.Cells(currRow, 3).Value
- raceTime = Format(newSheet.Cells(currRow, 2).Value, "h:mm")
- ' Add race course and race time to dictionary
- If Not raceData.Exists(raceCourse) Then
- raceData.Add raceCourse, New Collection
- End If
- ' Add race time to collection if it doesn't already exist
- Dim raceTimeCheck As Collection
- Set raceTimeCheck = raceData(raceCourse)
- Dim found As Boolean
- found = False
- Dim i As Long
- For i = 1 To raceTimeCheck.Count
- If raceTimeCheck(i) = raceTime Then
- found = True
- Exit For
- ElseIf raceTimeCheck(i) > raceTime Then
- raceTimeCheck.Add raceTime, Before:=i
- found = True
- Exit For
- End If
- Next i
- If Not found Then
- raceTimeCheck.Add raceTime
- End If
- Next currRow
- ' Populate TreeView with data from dictionary
- Dim raceCourses As Variant
- For Each raceCourses In raceData
- ' Add parent node for race course
- Dim currNode As Node
- Set currNode = TreeView1.Nodes.Add(, , raceCourses, raceCourses)
- currNode.Tag = raceCourses
- ' Add child nodes for race times
- Dim raceTimes As Variant
- For Each raceTimes In raceData(raceCourses)
- Set currNode = TreeView1.Nodes.Add(raceCourses, tvwChild, , raceTimes)
- currNode.Tag = raceTimes
- Next raceTimes
- Next raceCourses
- ' Clean up
- Set newSheet = Nothing
- Set raceData = Nothing
- End Sub
- Private Sub UserForm_Terminate()
- ' NOTES: Remove the sheet created when the form was initialized
- Application.DisplayAlerts = False 'Suppress alert message
- Workbooks("RaceCardAnalyser.xlsm").Sheets(targetSheetName).Delete
- Application.DisplayAlerts = True
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement