How to Create a Football Pitch and Ball Pass Logger with Excel VBA

Certain Football fans go a step further and track each ball pass on the field and analyze the game. With this article, you can easily create a software in Excel with which you can easily track each ball pass during a Football match

Download Now

If you want to start to use the software as soon as possible, then you can:

Download the Software Now

Otherwise, if you want to DIY, you can read the contents below.

Let’s prepare the GUI

We need two sheets. The first sheet should be named as “Pitch” and the other should be named as “Log”. The sheet “Log” will act as our database and on the sheet “Pitch” we will create the football field. Reduce the width of columns and rows, color the cells with Green and use white line border to create a football field on the Excel sheet.Create A Football Field On The Excel Sheet

Let’s prepare the database

On the “Log” sheet, create these following headers.

  1. Click Time
  2. Passing Position
  3. Passing Player
  4. Receiving Position
  5. Receiving player
  6. Success
  7. Distance of passCreate Headers

Let’s make it functional

As mentioned in the script section, copy code into their respective panes. You have to paste major part of the script into the code window of worksheet “Pitch”.

Let’s test it

Click anywhere on the Football pitch that we have created on the Excel sheet. You will be prompted to enter the squad number. Again click anywhere on the football pitch and you will be asked to enter the second squad’s number. Final question will be to check if the pass is a Success or Failure. Answer it by clicking the “yes” or “no” button. Now the log sheet will have a new row with values for all  7 fields.

How it works?

The script will track clicks on the sheet “Pitch” and based on SQRT formula distance of ball pass is calculated.

Script

Paste it the code pane of sheet “Pitch”

Private Sub Worksheet_Activate()
    ActiveSheet.ScrollArea = "AD9:EI82"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myValue As Variant
    If Not Intersect(Target, Target.Worksheet.Range("AD9:EI82")) Is Nothing Then
        If Selection.Cells.Count > 1 Then
            MsgBox "Sorry, multiple selections are not allowed.", vbCritical
            Range("A1").Select
            Exit Sub
        End If
        With Target.Interior
            .Color = 255
        End With
        With Range("AD9:EI82").Interior
            .Color = RGB(146, 208, 80)
        End With
        With Target.Interior
            .Color = 255
        End With
        Dim v_lr As Long
        v_lr = Sheets("Log").Range("F" & Rows.Count).End(xlUp).Row + 1
        If Sheets("Log").Range("B" & v_lr).Value = "" Then
            myValue = InputBox("Enter 1st squad number", "", "")
            Sheets("Log").Range("A" & v_lr).Value = Now
            Sheets("Log").Range("B" & v_lr).Value = Target.Address
            Sheets("Log").Range("C" & v_lr).Value = myValue
        Else
            myValue = InputBox("Enter 2nd squad number", "", "")
            Sheets("Log").Range("D" & v_lr).Value = Target.Address
            Sheets("Log").Range("E" & v_lr).Value = myValue
            Dim iReply As Integer
            iReply = MsgBox(Prompt:="Success ?", _
            Buttons:=vbYesNo, Title:="Pass")
            If iReply = vbYes Then
                Sheets("Log").Range("F" & v_lr).Value = "YES"
            Else
                Sheets("Log").Range("F" & v_lr).Value = "NO"
            End If
        End If
        If Sheets("Log").Range("B" & v_lr).Value <> "" And Sheets("Log").Range("D" & v_lr).Value <> "" Then
            Sheets("Log").Range("G" & v_lr).Formula = "=SQRT(SUMSQ(COLUMNS(Pitch!" & Sheets("Log").Range("B" & v_lr).Value & ":" & Sheets("Log").Range("D" & v_lr).Value & ") - 1, ROWS(Pitch!" & Sheets("Log").Range("B" & v_lr).Value & ":" & Sheets("Log").Range("D" & v_lr).Value & ") - 1))"
            Sheets("Log").Range("G" & v_lr).Value = Round(Sheets("Log").Range("G" & v_lr).Value, 2)
        End If
    End If
End Sub

Paste it in a new module

Sub Find_Distance()
    Dim r As Long
    r = Sheets("Log").Range("A" & Rows.Count).End(xlUp).Row
    Dim v_lr As Long
    For v_lr = 3 To r
        Sheets("Log").Range("C" & v_lr).Formula = "=SQRT(SUMSQ(COLUMNS(Pitch!" & Sheets("Log").Range("B" & v_lr - 1).Value & ":" & Sheets("Log").Range("B" & v_lr).Value & ") - 1, ROWS(Pitch!" & Sheets("Log").Range("B" & v_lr - 1).Value & ":" & Sheets("Log").Range("B" & v_lr).Value & ") - 1))"
        Sheets("Log").Range("C" & v_lr).Value = Round(Sheets("Log").Range("C" & v_lr).Value, 2)
    Next
End Sub

In case of Excel corruption and you want to fix corrupted Excel file , you can use Excel recovery tools such as DataNumen Excel Repair.

Author Introduction:

Nick Vipond is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including repair docx and outlook recovery software products. For more information visit www.datanumen.com

Comments are closed.