Jump to content
News Ticker
  • Welcome to the Community
  • Use the forum to troubleshoot your Excel & VBA Problems
  • We will be launching a new website soon! www.ExcelWTF.com/Learn ! Join us to learn VBA from the ground up!
  • 0
Ryan

Help replacing messy macro's with clean VBA

Question

I'm creating a fantasy drafting tool to use in fantasy football. I have it setup how I want it, but I am lost with all things VBA. Currently, I'm just recording Macros on each checkbox click, but I'm pretty sure some VBA code would work a lot better.

Background on the tool, it is a VBD (Value-Based Drafting) drafting tool. The way it works is you input your player projections for the season and your leagues scoring, and it totals the fantasy points for that player. The VBD part comes in by taking a baseline number for each position and subtracting each player's total fantasy points from that baseline number. The way to get that baseline number is by counting/guessing/figuring out how many players at each position will be drafted in the first 100 pick selections. For instance, I'm estimating 11 quarterbacks will be selected in the first 100 picks, so the total fantasy points for the 11th quarterback on the list becomes the baseline number. Every quarterback's fantasy points are subtracted from this figure giving you an X-Value, this is done for each position. The 11th QB on my list is Eli Manning, and I project him to get 332.72 points, 332.72 is the baseline for QBs, and Eli Mannings x-value would be zero. The 4th ranked QB on my list is Drew Brees, and I project him to get 381.08 points. 381.08 points minus the baseline set by Eli Manning of 332.72 points gives Brees an x-value of 47.36. When a quarterback is drafted, he is removed from the equation, and every quarterback below him moves up, so the baseline changes to the new 11th ranked quarterback and all x-values will adjust.

I've got an excel sheet representing this but the only way I know how to make it all work is by putting a macro enabled check box for all 500 players, when a box is ticked next to the player it deletes the fantasy point projection for that player and sorts the list by x-value. Very clunky and sloppy and I know there's an easier way to do this I just don't know how or it requires VBA which is out of my league (at least until I get my computer science degree).
I should also mention that I have posted this question for help on another site, https://www.mrexcel.com/forum/excel-questions/1019659-excel-project-has-me-loss.html.  Have a look; input is very welcomed. Thank You

 

Until I figure out how to attach files here is a dropbox link to the excel sheet.

https://www.dropbox.com/s/7y6b36bitdyno0f/Fantasy Tool_test.xlsm?dl=0

Share this post


Link to post
Share on other sites

13 answers to this question

Recommended Posts

  • 0

Hi Ryan, 

 

Sorry for the delay, took me some time to type out all the extra comments! Hopefully they should explain most of the code. If you need any further clarification let me know!

Please see new file below (the old one had a mistake in the code, and may have deleted data it shouldnt have!)

https://ufile.io/pn1sb

 

So i think this new code below should work for you:

Code:

  Sub PlayerDraft()
'Source: www.ExcelWTF.com
    '// Declare variables
    Dim shOverall As Worksheet, Sht As Worksheet
    Dim lrO As Long, lrPos As Long, PlayerRow As Long
    Dim rPos As Long, colFantPt As Long, colX As Long
    Dim Player As String, Position As String
    Set shOverall = Sheets("Overall")
    Dim Chk As CheckBox
    
    Application.ScreenUpdating = False
    
    '// Main Code
    'Find last used row on the 'Overall' sheet
    lrO = shOverall.Range("B" & Rows.Count).End(xlUp).Row
    'Find out if the check box clicked is on or off (1 or 0)
    Set Chk = Sheets("Overall").CheckBoxes(Application.Caller)
    'If the checkbox clicked is 1
    If Chk = 1 Then
        'Check the row the Check box is on
        PlayerRow = Chk.TopLeftCell.Row
        'Find Players Name by looking in adjacent column B of that row
        Player = shOverall.Range("B" & PlayerRow).Value
        'Find the players position (RB, WR, QB etc) and create a reference to that sheet
        Set Sht = Sheets(Range("C" & PlayerRow).Value)

        With Sht
            'Find the last used row of the Position sheet
            lrPos = Sht.Range("C" & Rows.Count).End(xlUp).Row
            'Find the row the Player is on the Position sheet
            rPos = .Range("C2:C" & lrPos).Find(Player).Row
            'On the position sheet, find the column number for the 'FantPt' Column
            colFantPt = .Rows(1).Find("FantPt").Column
            'On the position sheet, find the column number for the 'X-Factor' Column
            colX = .Rows(1).Find("X-Factor").Column
            'Clear the FantPt value for the player on the Position sheet
            .Cells(rPos, colFantPt).ClearContents
            'Clear any exisitng filters
            .AutoFilter.Sort.SortFields.Clear
            'Sort the 'X-Factor' column on the Position sheet
            .AutoFilter.Sort.SortFields.Add Key:=.Range( _
                .Cells(1, colX), .Cells(lrPos, colX)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
                xlSortNormal
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End With

        'Go back to the 'Overall' Sheet and sort on column G
        With shOverall
            .AutoFilter.Sort.SortFields.Clear
            .AutoFilter.Sort.SortFields.Add Key:= _
                Range("G1:G" & lrO), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
                :=xlSortNormal
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End With
    End If
    
    Application.ScreenUpdating = True

End Sub

 

Bearing in mind that the SETBOX code, only needs to be run once (which I have done on the attached sheet)... so you shouldnt have to do it again. 

Code:

Sub SetBox()
'Source: www.ExcelWTF.com
' This code only needs to be run once
' It will set each checkbox to run the PlayerDraft Macro when clicked
    Dim chkBx As CheckBox
    For Each chkBx In Sheets("Overall").CheckBoxes
        chkBx.OnAction = "PlayerDraft"
    Next
End Sub


 

Let me know if it works on your end, 

Cheers

Caleeco

  • Thanks 1

Share this post


Link to post
Share on other sites
  • 0

Hi Ryan, 

 

Thanks for your question! Before I dive into this, I see you have response/solution posted over on MrExcel.

 

Let me know if it's working for you, or if you still need my help on this particular problem :)

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0
17 minutes ago, Caleeco said:

Hi Ryan, 

 

Thanks for your question! Before I dive into this, I see you have response/solution posted over on MrExcel.

 

Let me know if it's working for you, or if you still need my help on this particular problem :)

Thanks

Caleeco

1

Thanks for your reply Caleeco, I have plugged the code from the response on the other site into the sheet and am returned with this error;

 

Set Chk = Sheets("Overall").CheckBoxes(Application.Caller)

 

I have yet to research what the error is as I am working on homework at the moment, but the author of the solution stated that they were unsure if it would work because they were using a different version of excel.

Share this post


Link to post
Share on other sites
  • 0
6 minutes ago, Ryan said:

Thanks for your reply Caleeco, I have plugged the code from the response on the other site into the sheet and am returned with this error;

 

Set Chk = Sheets("Overall").CheckBoxes(Application.Caller)

 

I have yet to research what the error is as I am working on homework at the moment, but the author of the solution stated that they were unsure if it would work because they were using a different version of excel.

 

Hi Ryan, 

 

It could potentially be a syntax problem. Could you let me know what the Error Message itself says?

 

Cheers

Caleeco

Share this post


Link to post
Share on other sites
  • 0
5 minutes ago, Caleeco said:

 

Hi Ryan, 

 

It could potentially be a syntax problem. Could you let me know what the Error Message itself says?

 

Cheers

Caleeco

I manually ran the "SetBox" macro because clicking a checkbox after inputing the code had no result.  After running the SetBox macro, when I click on a check box I get the following error message:

Run-time error '438':

Object doesn't support this property of method

 

If I manually run the "Fluff" macro I get the following error:

Run-time error '1004':

Unable to get the Checkboxes property of the Worksheet class

 

Share this post


Link to post
Share on other sites
  • 0

Hi Ryan, 

The Application.Call statement is used to check which OBJECT has called the macro. So when stepping through the code manually via the VB Editor, the macro has not been called by any checkbox. Hence the error. 

 

I'll try and implement it on your sheet, and see if I can get it working

 

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0

Hey Ryan, 

 

I had to change some of the original code, however, it seems to be working now. Please bare in mind you can't run this manually, you need to used the checkboxes to test! Please see attached file:

https://ufile.io/6g5kh

 

Which version of Excel are you running? I am using Excel 2016. 

Let me know if it works on your end. If so, I can tidy up the code, and add comments explaining what each line does if you'd like :)

 

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0
25 minutes ago, Caleeco said:

Hey Ryan, 

 

I had to change some of the original code, however, it seems to be working now. Please bare in mind you can't run this manually, you need to used the checkboxes to test! Please see attached file:

https://ufile.io/6g5kh

 

Which version of Excel are you running? I am using Excel 2016. 

Let me know if it works on your end. If so, I can tidy up the code, and add comments explaining what each line does if you'd like :)

 

Thanks

Caleeco

Cal,

Thanks for your help on this.  I am using 2016 also.  I want to dig through the code and changes.  I see it's working but doesn't appear to be working properly and maybe there is something I can spot to fix it.  On your end, when you click the checkbox next to David Johnson, where does he end up on the updated list after the click?  When I click the box, David Johnson remains as the #1 player on the list with a new x-value but drops to the #4 player on the RB Sheet.

 

My intentions are for the player drafted (checkbox selected) to either disappear from the overall sheet, drop to the bottom of the list, or simply be marked as drafted with a simple strikethrough font and all the x-values be changed accordingly.  the easiest way I could show this would be to go to the Sheet RB and delete the contents of Cell N2 then sort column U2 on Sheet RB.  Back on sheet Overall, sort column G.

Share this post


Link to post
Share on other sites
  • 0

Hmm... yes now that I look at it, not really doing what you need. I will re-write this code for you. Can I clarify these are the steps you wish the code to execute:

  1. User Clicks a checkbox
  2. Player clicked has strikethrough text to mark drafted
  3. Check the players position eg RB, QB, WR and navigate to that sheet name
  4. Find the player on the position sheet, and clear his "FantPt" value
  5. Sort "X-Factor" column on the position sheet
  6. Go back to the Overall sheet. and Sort on the X-Factor sheet there 

Is that correct? I assume the adjustment to the x-factor is done by your equations. 

Let me know

Thanks

Caleeco

Share this post


Link to post
Share on other sites
  • 0
9 minutes ago, Caleeco said:

Hmm... yes now that I look at it, not really doing what you need. I will re-write this code for you. Can I clarify these are the steps you wish the code to execute:

  1. User Clicks a checkbox
  2. Player clicked has strikethrough text to mark drafted
  3. Check the players position eg RB, QB, WR and navigate to that sheet name
  4. Find the player on the position sheet, and clear his "FantPt" value
  5. Sort "X-Factor" column on the position sheet
  6. Go back to the Overall sheet. and Sort on the X-Factor sheet there 

Is that correct? I assume the adjustment to the x-factor is done by your equations. 

Let me know

Thanks

Caleeco

That is correct, although I don't think the strikethrough of the name on the overall sheet would be necessary because when the players FantPt is cleared, and both lists are sorted, that player would disappear from the overall list.  if it doesn't take too much extra time out of your schedule, could you perhaps comment on some of the code, would be easier for me to pick it apart and learn

Edited by Ryan

Share this post


Link to post
Share on other sites
  • 0
17 hours ago, Caleeco said:

Hi Ryan, 

 

Sorry for the delay, took me some time to type out all the extra comments! Hopefully they should explain most of the code. If you need any further clarification let me know!

Please see new file below (the old one had a mistake in the code, and may have deleted data it shouldnt have!)

https://ufile.io/pn1sb

 

So i think this new code below should work for you:

Code:

  Sub PlayerDraft()
'Source: www.ExcelWTF.com
    '// Declare variables
    Dim shOverall As Worksheet, Sht As Worksheet
    Dim lrO As Long, lrPos As Long, PlayerRow As Long
    Dim rPos As Long, colFantPt As Long, colX As Long
    Dim Player As String, Position As String
    Set shOverall = Sheets("Overall")
    Dim Chk As CheckBox
    
    Application.ScreenUpdating = False
    
    '// Main Code
    'Find last used row on the 'Overall' sheet
    lrO = shOverall.Range("B" & Rows.Count).End(xlUp).Row
    'Find out if the check box clicked is on or off (1 or 0)
    Set Chk = Sheets("Overall").CheckBoxes(Application.Caller)
    'If the checkbox clicked is 1
    If Chk = 1 Then
        'Check the row the Check box is on
        PlayerRow = Chk.TopLeftCell.Row
        'Find Players Name by looking in adjacent column B of that row
        Player = shOverall.Range("B" & PlayerRow).Value
        'Find the players position (RB, WR, QB etc) and create a reference to that sheet
        Set Sht = Sheets(Range("C" & PlayerRow).Value)

        With Sht
            'Find the last used row of the Position sheet
            lrPos = Sht.Range("C" & Rows.Count).End(xlUp).Row
            'Find the row the Player is on the Position sheet
            rPos = .Range("C2:C" & lrPos).Find(Player).Row
            'On the position sheet, find the column number for the 'FantPt' Column
            colFantPt = .Rows(1).Find("FantPt").Column
            'On the position sheet, find the column number for the 'X-Factor' Column
            colX = .Rows(1).Find("X-Factor").Column
            'Clear the FantPt value for the player on the Position sheet
            .Cells(rPos, colFantPt).ClearContents
            'Clear any exisitng filters
            .AutoFilter.Sort.SortFields.Clear
            'Sort the 'X-Factor' column on the Position sheet
            .AutoFilter.Sort.SortFields.Add Key:=.Range( _
                .Cells(1, colX), .Cells(lrPos, colX)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
                xlSortNormal
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End With

        'Go back to the 'Overall' Sheet and sort on column G
        With shOverall
            .AutoFilter.Sort.SortFields.Clear
            .AutoFilter.Sort.SortFields.Add Key:= _
                Range("G1:G" & lrO), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
                :=xlSortNormal
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End With
    End If
    
    Application.ScreenUpdating = True

End Sub

 

Bearing in mind that the SETBOX code, only needs to be run once (which I have done on the attached sheet)... so you shouldnt have to do it again. 

Code:

Sub SetBox()
'Source: www.ExcelWTF.com
' This code only needs to be run once
' It will set each checkbox to run the PlayerDraft Macro when clicked
    Dim chkBx As CheckBox
    For Each chkBx In Sheets("Overall").CheckBoxes
        chkBx.OnAction = "PlayerDraft"
    Next
End Sub


 

Let me know if it works on your end, 

Cheers

Caleeco

I apologize, I thought I had responded to this yesterday, everything seems to be working great.  I've tested the tool out a few times and it does exactly what I need.  All I need to do is tidy up some of my formulas and figure out why the players and their Tm/Bye scramble on each sort.

 

Thanks for your help and thanks for adding the comments to the code!

  • Like 1

Share this post


Link to post
Share on other sites
  • 0
4 hours ago, Ryan said:

I apologize, I thought I had responded to this yesterday, everything seems to be working great.  I've tested the tool out a few times and it does exactly what I need.  All I need to do is tidy up some of my formulas and figure out why the players and their Tm/Bye scramble on each sort.

 

Thanks for your help and thanks for adding the comments to the code!

 

Hi Ryan, 

 

No problem, Glad the code is working :D That's ok, it's good to see you're keen to learn about how the code works too!

 

If you have any follow up questions or any new VBA problems, don't hesitate to stop back here on the forum :)

 

Cheers

Caleeco 

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×