PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
Need help with increasing the speed of my code-VBForums
Results 1 to 7 of 7

Thread: Need help with increasing the speed of my code

  1. #1

    Thread Starter
    New Member
    Join Date
    Jul 2019
    Posts
    1

    Need help with increasing the speed of my code

    First time posting- hope this is in the right spot. My whole sub is taking about a minute or 2 for just 20 loops and I'm planning on or hoping at least to bump this up to 1000 times through the loop.

    Essentially what I want the code to do is look up values associated with each team (vlookup) from another sheet in the workbook, multiply the values together to create scores, and then repeat matchups between the 2 teams from cells A1:A1000 for the home team and the same for the away team in column B. Then to give a 1 or a 0 in column c depending on which team won. I feel like these calculations should be relatively easy but is taking a long time for Excel to calculate.

    Here is my code for reference. Any help would be greatly appreciated:

    VB Code:
    1. Sub Loop_Matchup()
    2. Application.ScreenUpdating = False
    3. Dim HomeTeam As String
    4. Dim AwayTeam As String
    5. Dim HomeOFF As Single
    6. Dim HomeDEF As Single
    7. Dim AwayOFF As Single
    8. Dim AwayDEF As Single
    9. Dim HomePoss As Single
    10. Dim AwayPoss As Single
    11. Dim HomeStart As Range
    12. Dim AwayStart As Range
    13. Dim x As Integer
    14. Dim y As Integer
    15. Dim HomeScore As Single
    16. Dim AwayScore As Single
    17.  
    18.  
    19. HomeTeam = InputBox("Home Team")
    20. AwayTeam = InputBox("Away Team")
    21.  
    22. HomeOFF = WorksheetFunction.VLookup(HomeTeam, Worksheets("Stats").Range("A1: DZ360"), 117, 0)
    23. HomeDEF = WorksheetFunction.VLookup(HomeTeam, Worksheets("Stats").Range("A1: DZ360"), 119, 0)
    24. AwayOFF = WorksheetFunction.VLookup(AwayTeam, Worksheets("Stats").Range("A1: DZ360"), 117, 0)
    25. AwayDEF = WorksheetFunction.VLookup(AwayTeam, Worksheets("Stats").Range("A1: DZ360"), 119, 0)
    26. HomePoss = WorksheetFunction.VLookup(HomeTeam, Worksheets("Stats").Range("A1: DZ360"), 79, 0)
    27. AwayPoss = WorksheetFunction.VLookup(AwayTeam, Worksheets("Stats").Range("A1: DZ360"), 79, 0)
    28.  
    29.  
    30. Sheets("Sheet2").Select
    31.    
    32. x = 2
    33. y = 2
    34. Do While x <= 21
    35.     HomeScore = Round(HomeOFF * AwayDEF * (HomePoss + AwayPoss - 72), 0)
    36.     AwayScore = Round(AwayOFF * HomeDEF * (HomePoss + AwayPoss - 72), 0)
    37.    
    38.         Cells(x, 1).Value2 = HomeScore
    39.         Cells(x, 2).Value2 = AwayScore
    40.        
    41.     x = x + 1
    42.    
    43. Loop
    44.  
    45. Do While y <= 21
    46.     If Cells(y, 1) > Cells(y, 2) _
    47.         Then
    48.             Cells(y, 3).Value2 = 1
    49.             Cells(y, 4).Value2 = 0
    50.         Else
    51.             Cells(y, 3).Value2 = 0
    52.             Cells(y, 4).Value2 = 1
    53.     End If
    54.    
    55.     y = y + 1
    56. Loop
    57.  
    58. Application.ScreenUpdating = False
    59.  
    60. End Sub
    Last edited by FunkyDexter; Jul 30th, 2019 at 03:14 AM.

  2. #2
    Sinecure devotee
    Join Date
    Aug 2013
    Location
    Southern Tier NY
    Posts
    5,333

    Re: Need help with increasing the speed of my code

    I informed a moderator, so the question should be moved to the Office, Excel, VBA area since this is a question about using VBA in excel, and not a VB6 question.

  3. #3
    Fanatic Member
    Join Date
    Feb 2003
    Posts
    721

    Re: Need help with increasing the speed of my code

    Quote Originally Posted by passel View Post
    I informed a moderator, so the question should be moved to the Office, Excel, VBA area since this is a question about using VBA in excel, and not a VB6 question.
    To the OP: you should also use code tags when posting code. Have a look at the "#" button when posting a message.

  4. #4
    Addicted Member
    Join Date
    Jan 2015
    Posts
    169

    Re: Need help with increasing the speed of my code

    i did not get ur code meaning, it seems contradictory.
    VB Code:
    1. Enum eIndex
    2.     ePoss = 79
    3.     eOFF = 117
    4.     eDEF = 119
    5. End Enum
    6.  
    7. Sub Loop_Matchup()
    8.     Application.ScreenUpdating = False
    9.     Dim HomeTeam As String
    10.     Dim AwayTeam As String
    11.     Dim HomeOFF As Single
    12.     Dim HomeDEF As Single
    13.     Dim HomePoss As Single
    14.     Dim AwayOFF As Single
    15.     Dim AwayDEF As Single
    16.     Dim AwayPoss As Single
    17.     Dim HomeScore As Single
    18.     Dim AwayScore As Single
    19. '    Dim HomeStart As Range        'variable not used
    20. '    Dim AwayStart As Range        'variable not used
    21. '    Dim x As Integer              'variable no more need
    22. '    Dim y As Integer              'variable no more need
    23.  
    24.     Dim arrSrc, arrDst, i&
    25.     Dim bool1 As Boolean, bool2 As Boolean
    26.     Dim shtSrc As Worksheet
    27.     Dim shtDst As Worksheet
    28.     Const n = 360
    29.     Set shtSrc = ThisWorkbook.Worksheets("Stats")
    30.    
    31.     HomeTeam = InputBox("Home Team")
    32.     AwayTeam = InputBox("Away Team")
    33.    
    34.     arrSrc = shtSrc.Range("A1:DZ360")
    35.    
    36.     bool1 = False: bool2 = False
    37.     For i = 1 To n                                     'use only one loop
    38.         If (bool1 And bool2) Then Exit For
    39.         If bool = False Then
    40.             If arr1(i, 1) = HomeTeam Then
    41.                 HomePoss = arrSrs(i, eIndex.ePoss)
    42.                 HomeOFF = arrSrc(i, eIndex.eOFF)
    43.                 HomeDEF = arrSrc(i, eIndex.eDEF)
    44.                 bool1 = True
    45.             End If
    46.         End If
    47.         If bool2 = False Then
    48.             If arr1(i, 1) = AwayTeam Then
    49.                 AwayPoss = arrSrs(i, eIndex.ePoss)
    50.                 AwayOFF = arrSrc(i, eIndex.eOFF)
    51.                 AwayDEF = arrSrc(i, eIndex.eDEF)
    52.                 bool2 = True
    53.             End If
    54.         End If
    55.     Next i
    56.    
    57. '    HomePoss = WorksheetFunction.VLookup(HomeTeam, shtSrc.Range("A1:DZ360"), 79, 0)
    58. '    HomeOFF = WorksheetFunction.VLookup(HomeTeam, shtSrc.Range("A1:DZ360"), 117, 0)
    59. '    HomeDEF = WorksheetFunction.VLookup(HomeTeam, shtSrc.Range("A1:DZ360"), 119, 0)
    60. '    AwayPoss = WorksheetFunction.VLookup(AwayTeam, shtSrc.Range("A1:DZ360"), 79, 0)
    61. '    AwayOFF = WorksheetFunction.VLookup(AwayTeam, shtSrc.Range("A1:DZ360"), 117, 0)
    62. '    AwayDEF = WorksheetFunction.VLookup(AwayTeam, shtSrc.Range("A1:DZ360"), 119, 0)
    63.  
    64.     Set shtDst = ThisWorkbook.Worksheets("Sheet2")
    65.     Set arrDst = ThisWorkbook.Worksheets("A1:D27")        'read one time
    66.     HomeScore = Round(HomeOFF * AwayDEF * (HomePoss + AwayPoss - 72), 0)
    67.     AwayScore = Round(AwayOFF * HomeDEF * (HomePoss + AwayPoss - 72), 0)
    68.    
    69.     For i = 2 To 21
    70.         arrDst(i, 1) = HomeScore
    71.         arrDst(i, 2) = AwayScore
    72.         aBool = (HomeScore > AwayScore)
    73.         arrDst(i, 3) = -1 * aBool
    74.         arrDst(i, 4) = aBool + 1
    75.     Next i
    76.     shtDst.Range("A1:D27").Value2 = arrDst                 'write one time
    77.    
    78. '    x = 2
    79. '    y = 2
    80. '    Do While x <= 21
    81. '        HomeScore = Round(HomeOFF * AwayDEF * (HomePoss + AwayPoss - 72), 0)    'why in the loop??? but every loop get the same value
    82. '        AwayScore = Round(AwayOFF * HomeDEF * (HomePoss + AwayPoss - 72), 0)
    83. '        shtDst.Cells(x, 1).Value2 = HomeScore
    84. '        shtDst.Cells(x, 2).Value2 = AwayScore
    85. '        x = x + 1
    86. '    Loop
    87. '    Do While y <= 21
    88. '        If shtDst.Cells(y, 1) > shtDst.Cells(y, 2) Then   'why reading array???
    89. '            shtDst.Cells(y, 3).Value2 = 1
    90. '            shtDst.Cells(y, 4).Value2 = 0
    91. '        Else
    92. '            shtDst.Cells(y, 3).Value2 = 0
    93. '            shtDst.Cells(y, 4).Value2 = 1
    94. '        End If
    95. '        y = y + 1
    96. '    Loop
    97.     Application.ScreenUpdating = True
    98. End Sub
    Last edited by loquat; Aug 2nd, 2019 at 09:27 AM.

  5. #5
    Addicted Member
    Join Date
    Jan 2015
    Posts
    169

    Re: Need help with increasing the speed of my code

    Duplicate post...
    Last edited by loquat; Jul 29th, 2019 at 06:43 AM. Reason: Duplicate post

  6. #6
    Super Moderator FunkyDexter's Avatar
    Join Date
    Apr 2005
    Location
    An obscure body in the SK system. The inhabitants call it Earth
    Posts
    7,317

    Re: Need help with increasing the speed of my code

    Welcome to the forums

    Moved to Office Development. It's worth exploring our sub forums a little to find your way around. If you post a question in the wrong place you're likely to get confusing responses.

    I also added code tags to your post. You can add basic formatting using the # button. You can add more advanced formatting using the VB button and adding a highlight option. In this case I used VB.
    You can depend upon the Americans to do the right thing. But only after they have exhausted every other possibility - Winston Churchill

    Hadoop actually sounds more like the way they greet each other in Yorkshire - Inferrd

  7. #7
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,433

    Re: Need help with increasing the speed of my code

    one way to significantly increase speed is to store all values to a 2d array, then assign the array to a range after all processing

    an example i tested doing this increased speed by 10x
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width