Excel Attributes Spreadsheet Version 2 (10/02/2009 05:52)

After making my last blog, I realised that explaining how to create the spreadsheet would not be adequate as it required some effort and too many things could go wrong. To correct this I have improved the spreadsheet so that it only requires the copying and pasting of macros and the spreadsheet setup macro will set up all of the formatting and formulae etc. that the spreadsheet needs. I have also expanded it to cater for 33 players in a squad.

The spreadsheet.
Please Note: This spreadsheet has been designed in Excel 2003 and my short testing in Excel 2007 shows that it is functional but some of the formulae and formatting are not being set up properly. This may mean that you have to try to set up the formulae manually from my previous blog :o I personally don't use Excel 2007 and get frustrated with the ribbon so may or may not work out the problems. I don't have an internet enabled computer with Excel 97 or 2000 so have not tested the macros in either.

Please Note: The process of copying and pasting will not work with Microsoft Internet Explorer. For some reason the copied data is pasted as one continuous row ... take Spinner's advice and upgrade (that is right, you will notice the improvement) to Mozilla Firefox, Google Chrome or Opera ;) I haven't tested this with Opera either but I know that it works with Firefox and Chrome.



The spreadsheet is designed to make it easier to distinguish which players have gained attributes since the last copy and paste and show the players' total gains for the season which makes it easier to choose an attribute to train during training or training camps.

The completed operational spreadsheet should look like below. If you look where the cursor was on the screenshot, you will notice that I have added a function to highlight the row when a player gains an attribute, the attribute is highlighted and a "tooltip" shows which sort of attribute it was (+1 Heading for Robert Thorkildsen in this case).



Building the Spreadsheet.

Step One.
Open Microsoft Excel with a new blank spreadsheet. Select "Tools -> Macros -> Visual Basic Editor" from the menu (or press Alt+F11) which will start the Visual Basic Editor (VBE) that is contained within Excel. Go to "Insert -> Module" on the menu. An empty sheet will appear and this is where you paste the macros from below. Copy the macro below (within the lines) and go back to the Visual Basic Editor and paste it into the module. This is the macro that performs all the day-to day operations of the spreadsheet. When you paste it into the module you will notice that lines that are after an apostrophe (') are in green - these are comments are my attempt to explain what each part is for if you wish to look at the code. 

---

Sub ImportPlayerData()
'Paste the copied data
    Range("A83").Select
    ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
        DisplayAsIcon:=False
'Delete the unrequired data eg Age, Resting, Training Now columns.
    Range("O83:P116").Select
    Selection.Delete Shift:=xlToLeft
'Sort the data into positions and then alphabetical order
    Range("B84:P116").Select
    Selection.Sort Key1:=Range("B83"), Order1:=xlAscending, Key2:=Range("C83" _
        ), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
' Remove the Q increase from the right of the Q value
Dim c As Variant
Dim d As Variant
Dim remover As Variant
    For Each c In Range("D84:D116")
        d = c.Value
        remover = Val(d)
        c.Value = remover
    Next
'Remove the "Inj" from the fitness of injured players (not required when copying from Google Chrome)
Dim e As Variant
Dim f As Variant
Dim remover2 As Variant
    For Each e In Range("M84:M116")
        f = e.Value
        remover = Val(f)
        e.Value = remover
    Next
'Start the macro called CalcChanges
    Call CalcChanges
'Copy the data from Section 3 to Section 2
    Range("B84:P116").Select
    Selection.Copy
    Range("B40").Select
    ActiveSheet.Paste

End Sub
Sub CalcChanges()
'Clear the old comments in Section 5
    Range("U40:AD72").Select
    Selection.ClearComments
'Clear old colour fills
    Range("S40:AF74").Select
    Selection.Interior.ColorIndex = xlNone
'Compare the cells from Section 3 to Section 2 to calculate attribute increases
        'since last paste and put them into section 5
    Range("U40:AD72") = Evaluate("D84:M116-D40:M72")

'Format the cells with attribute gains
    Dim x1 As Range
    Dim x2 As Range
'Change the background and add comment for each cell that has an attribute increase
    For Each a In Range("U40:U72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -2)
                Set x2 = a.Offset(0, 11)
                Range(x1, x2).Select
                Selection.Interior.ColorIndex = 36 'cream
            'Change the cell fill colour and add comment
            a.Interior.ColorIndex = 8 'cyan
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Quality"
        End If
    Next
    For Each a In Range("V40:V72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -3)
                Set x2 = a.Offset(0, 10)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Keeping"
        End If
    Next
    For Each a In Range("W40:W72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -4)
                Set x2 = a.Offset(0, 9)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Tackling"
        End If
    Next
    For Each a In Range("X40:X72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -5)
                Set x2 = a.Offset(0, 8)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Passing"
        End If
    Next
    For Each a In Range("Y40:Y72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -6)
                Set x2 = a.Offset(0, 7)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Shooting"
        End If
    Next
    For Each a In Range("Z40:Z72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -7)
                Set x2 = a.Offset(0, 6)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Heading"
        End If
    Next
    For Each a In Range("AA40:AA72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -8)
                Set x2 = a.Offset(0, 5)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Speed"
        End If
    Next
    For Each a In Range("AB40:AB72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -9)
                Set x2 = a.Offset(0, 4)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Stamina"
        End If
    Next
    For Each a In Range("AC40:AC72")
        If a.Value > 0 Then
            'Change the fill colour of the row
                Set x1 = a.Offset(0, -10)
                Set x2 = a.Offset(0, 3)
                Range(x1, x2).Select
                If Selection.Interior.ColorIndex = xlNone Then Selection.Interior.ColorIndex = 36 'cream
            a.Interior.ColorIndex = 4 'green
            a.AddComment
            a.Comment.Visible = False
            a.Comment.Text Text:="Perception"
        End If
    Next

'Change the size of comments (code adapted from Ivan Moala's code) and the font in comments
    Dim AllComments As Range
    Dim ComCell As Range
    On Error Resume Next
    Set AllComments = Range("U40:AD72").SpecialCells(xlCellTypeComments)
    If AllComments Is Nothing And Not All Then GoTo GetOut
        For Each ComCell In AllComments
        With ComCell.Comment
            .Shape.Height = .Shape.Height * 0.27
            .Shape.Width = .Shape.Width * 0.55
            .Shape.TextFrame.Characters.Font.ColorIndex = 3
            .Shape.TextFrame.Characters.Font.Name = "arial"
            .Shape.TextFrame.Characters.Font.Size = 10
            .Shape.TextFrame.Characters.Font.Bold = False
        End With
        Next ComCell
GetOut:
End Sub
Sub ColourChanger()
   
'Change the background colour according to the main stats of different positions in Section 4
Dim a As Variant
    Range("S3").Activate
    For Each a In Range("S3:S35")
        If a.Value = "Att" Then
            ActiveCell.Offset(0, 6).Select
                Selection.Interior.ColorIndex = 3 'red
            ActiveCell.Offset(0, 1).Select
                Selection.Interior.ColorIndex = 3 'red
            ActiveCell.Offset(0, 1).Select
                Selection.Interior.ColorIndex = 3 'red
            ActiveCell.Offset(0, 2).Select
                Selection.Interior.ColorIndex = 3 'red
            ActiveCell.Offset(1, -10).Select
        ElseIf a.Value = "Def" Then
            ActiveCell.Offset(0, 4).Select
                Selection.Interior.ColorIndex = 50 'green
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 1).Select
                Selection.Interior.ColorIndex = 50 'green
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 3).Select
                Selection.Interior.ColorIndex = 50 'green
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 1).Select
                Selection.Interior.ColorIndex = 50 'green
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(1, -9).Select
        ElseIf a.Value = "Gk" Then
            ActiveCell.Offset(0, 3).Select
                Selection.Interior.ColorIndex = 5 'blue
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 2).Select
                Selection.Interior.ColorIndex = 5 'blue
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 3).Select
                Selection.Interior.ColorIndex = 5 'blue
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 2).Select
                Selection.Interior.ColorIndex = 5 'blue
                Selection.Font.ColorIndex = 6 'yellow
            ActiveCell.Offset(1, -10).Select
        ElseIf a.Value = "Mid" Then
            ActiveCell.Offset(0, 4).Select
                Selection.Interior.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 1).Select
                Selection.Interior.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 1).Select
                Selection.Interior.ColorIndex = 6 'yellow
            ActiveCell.Offset(0, 2).Select
                Selection.Interior.ColorIndex = 6 'yellow
            ActiveCell.Offset(1, -8).Select
       
        End If

    Next
End Sub
Sub MSFormula()
   
'Create the fomula to add up the main stats in Section 4
Dim a As Variant
    Range("S3").Activate
    For Each a In Range("S3:S35")
        If a.Value = "Att" Then
            ActiveCell.Offset(0, 12).Select
                ActiveCell.FormulaR1C1 = "=RC[-6]+RC[-5]+RC[-4]+RC[-2]"
            ActiveCell.Offset(1, -12).Select
        ElseIf a.Value = "Def" Then
            ActiveCell.Offset(0, 12).Select
                ActiveCell.FormulaR1C1 = "=RC[-8]+RC[-7]+RC[-4]+RC[-3]"
            ActiveCell.Offset(1, -12).Select
        ElseIf a.Value = "Gk" Then
            ActiveCell.Offset(0, 12).Select
                ActiveCell.FormulaR1C1 = "=RC[-9]+RC[-7]+RC[-4]+RC[-2]"
            ActiveCell.Offset(1, -12).Select
        ElseIf a.Value = "Mid" Then
            ActiveCell.Offset(0, 12).Select
                ActiveCell.FormulaR1C1 = "=RC[-8]+RC[-7]+RC[-6]+RC[-4]"
            ActiveCell.Offset(1, -12).Select
        End If

    Next
End Sub

---

Second Set of Macros
Insert another module in the VBE ("Insert -> Module") and copy the next macro into the new module that is called Module 2. This second set of macros is all to do with setting up the spreadsheet (DO NOT run it yet!). It will put the appropriate formulae where they are required, put the headings where they are required, and do all the relevant formatting (eg colouring the boxes in Section 4 etc.). These macros will be only used once but you can leave them in the workbook just in case you wish to start the spreadsheet again.

---

Sub Setup_Spreadsheet()
'Rename Sheet1 to Attributes
    Worksheets(1).Name = "Attributes"
    Worksheets("Attributes").Activate
'Paste the data from ML into the spreadsheet
    Call ImportPlayerData
'Paste the Square of data around the page
    Range("A83:P116").Select
    Selection.Copy
    Range("A39").Select
    ActiveSheet.Paste
    Range("R39").Select
    ActiveSheet.Paste
    Range("A2").Select
    ActiveSheet.Paste
    Range("R2").Select
    ActiveSheet.Paste
    Worksheets("Attributes").Columns("A:AG").AutoFit
    Range("Q1:R73").ClearContents
   
'Start the setup of formulae through the SetupFormulae macro :)
    Call SetupFormulae
'Setup the Main Stat Formulae in column AE
    Call MSFormula
'Start the Colour Changer macro for Section 4
    Call ColourChanger
'Start the extra formatting code
    Call Formatting
'Start the code for creating the Insert/Delete Player dialogs NB Unused now
'    Call CreateDialogs
End Sub
Sub SetupFormulae()
'Setup Section 4
    Range("U3").Select
    ActiveCell.FormulaR1C1 = "=R[37]C[-17]-RC[-17]"
    Selection.AutoFill Destination:=Range("U3:U35"), Type:=xlFillDefault
    Range("U3:U35").Select
    Selection.AutoFill Destination:=Range("U3:AD35"), Type:=xlFillDefault
    Range("U36").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-33]C:R[-1]C)"
    Selection.AutoFill Destination:=Range("U36:AF36"), Type:=xlFillDefault
    Range("AD2").Select
    ActiveCell.FormulaR1C1 = "Total"
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "Main"
    Range("AE2").Select
    ActiveCell.FormulaR1C1 = "Stat"
    Range("AF2").Select
    ActiveCell.FormulaR1C1 = "%MS"
    Range("AG2:AG72").ClearContents
    Range("AD3").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-1])"
    Selection.AutoFill Destination:=Range("AD3:AD35"), Type:=xlFillDefault
    Range("AF3").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-2]"
    Selection.AutoFill Destination:=Range("AF3:AF36"), Type:=xlFillDefault
'Put border around formulae
    Range("U36:AF36").Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
   
'Setup Section 5
    Range("U40:AF69").ClearContents
    Range("AE39:AF39").ClearContents
    Range("AF39").Select
    ActiveCell.FormulaR1C1 = "Total"
    Range("AF40").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-10]:RC[-3])"
    Selection.AutoFill Destination:=Range("AF40:AF72"), Type:=xlFillDefault
    Range("U74").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
    Selection.AutoFill Destination:=Range("U74:AF74"), Type:=xlFillDefault
'Put border around formulae
    Range("U74:AF74").Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With


'Centre the alignment on all tables
    Range("U3:AF36").HorizontalAlignment = xlCenter
    Range("D3:P35").HorizontalAlignment = xlCenter
    Range("D40:P72").HorizontalAlignment = xlCenter
    Range("U40:AF74").HorizontalAlignment = xlCenter
    Range("D84:P116").HorizontalAlignment = xlCenter

'Bolden and centre the top line of each section
    Range("S39:AF39").Select
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlCenter
    Range("S1:AF2").Select
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlCenter
    Range("A2:P2").Select
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlCenter
    Range("A39:P39").Select
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlCenter


End Sub

Sub Formatting()
'Autofit column widths
    Worksheets("Attributes").Columns("A:AG").AutoFit

'Add titles to each Section.
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Start of the Season"
    Selection.Font.Size = 14
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlLeft
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "Attribute Gains"
    Selection.Font.Size = 14
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlLeft
    Range("A38").Select
    ActiveCell.FormulaR1C1 = "End of Season"
    Selection.Font.Size = 14
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlLeft
    Range("S38").Select
    ActiveCell.FormulaR1C1 = "Changes since last copy and paste:"
    Selection.Font.Size = 14
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlLeft
'Autofit row heights to allow for the new titles
    Worksheets("Attributes").Rows("1:116").AutoFit
   
'Create the Command Button
    Worksheets(1).OLEObjects.Add "Forms.CommandButton.1", Left:=110, Top:=950, Width:=250, _
        Height:=80
       
End Sub

---

Third Macro
Insert another module in the VBE ("Insert -> Module") and copy the next macro into the new module that is called Module 3. This macro formats the button on the spreadsheet so that it is nice and pretty :). This last macro will have to be run separately after the whole spreadsheet is set up

---

Sub FormatButton()
    With Worksheets(1).CommandButton1
        .Caption = "Import Current Player Data"
        .Font.Size = 14
        .Font.Bold = True
        .ForeColor = &HFF&
        .MousePointer = 10
       
    End With
End Sub

---

Save the Excel workbook with whatever name you choose - I use Attributes Season 45 etc.

Please continue to the next page to see how to finalise the set-up in Step Two.