Slow VBA Macro

S

steveh8204

Board Regular
Joined
Aug 20, 2018
Messages
151
I've made a macro in vba which is taking quite a bit of time to run (approx 70 secs) and was wondering if there's any way to make it run more efficiently.

It basically just copies and pastes a couple of values, pastes them in another sheet then extracts about a dozen values, switches the sheet then pastes them values in. It then repeats this process up to 12 times.

There's a few formulas as well in the final output sheet but can't imagine these hold it up much. The macro code is below if anyone wants to have a look. Any tips on how to speed it up would be appreciated.

Thanks in advance.

VBA Code: 
Sub games_batch_compare()

Range("C21").Value = "Calculating...."

Application.ScreenUpdating = False

Dim a As Variant, b As Variant, c As Variant, d As Variant, e As Variant, f As Variant, g As Variant, h As Variant
Dim i As Integer, j As Variant, k As Variant, l As Variant, m As Variant, n As Variant, o As Variant, league As Variant

' make sure selected league from top left matches "SELECT LEAGUE"

league = Range("D1")

Worksheets("SELECT LEAGUE").Select

Cells(2, 5).Value = league

Worksheets("Games").Select ' back to "Games" sheet


For i = 3 To 15

a = Cells(i, 3) ' selected Home Team into variable a
b = Cells(i, 5) ' selected Away team into variable b

If a = "" Then i = 15

Worksheets("H2H").Select

Range("L3").Value = a ' change H2H Home team to variable a
Range("S3").Value = b ' change H2H Away team to variable b
c = Range("L17") ' declare as home team goals scored
d = Range("s18") ' declare as away team Goals scored
e = Range("N17") ' declare as home team Goals conceded
f = Range("U18") ' declare as away team Goals conceded
g = Range("n46") ' declare as clean sheets home
h = Range("n52") ' declare as failed to score Home
j = Range("u47") ' declare as clean sheets away
k = Range("u53") ' declare as failed to score away
l = Range("l11") ' declare as home position Overall
m = Range("l12") ' declare as home position home
n = Range("s13") ' declare as away position away
o = Range("s11") ' declare as away position overall
p = Range("q206") ' declare as home team points last 4
q = Range("Z207") ' declare as away team points last 4

If a = "" Then c = "N/A"
If a = "" Then d = "N/A"
If a = "" Then e = "N/A"
If a = "" Then d = "N/A"
If a = "" Then f = "N/A"
If a = "" Then g = "N/A"
If a = "" Then h = "N/A"
If a = "" Then j = "N/A"
If a = "" Then k = "N/A"
If a = "" Then l = "N/A"
If a = "" Then m = "N/A"
If a = "" Then n = "N/A"
If a = "" Then o = "N/A"

Worksheets("Games").Select

Cells(i, 7).Value = c ' goals scored H
Cells(i, 8).Value = d ' goals scored A
Cells(i, 10).Value = e ' goals conceded H
Cells(i, 11).Value = f ' goals conceded A
Cells(i, 13).Value = g ' clean sheets home
Cells(i, 14).Value = h ' failed to score Home
Cells(i, 15).Value = j ' clean sheets away
Cells(i, 16).Value = k ' failed to score Away
Cells(i, 17).Value = l ' home position overall
Cells(i, 18).Value = m ' home position home
Cells(i, 19).Value = n ' away position away
Cells(i, 20).Value = o ' away position overall
Cells(i, 26).Value = p ' home team points last 4
Cells(i, 27).Value = q ' away team points last 4

Next i

Application.ScreenUpdating = True

Range("C21").Value = "Complete!"

End Sub
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
Nothing obvious to me re: taking too long. However,
- you have a couple of undeclared variables (p & q)
- might be faster if so many variables were not variants
- If a = "" Then i = 15 is supposed to stop code execution, it won't. The counter will then be 15 but will still process the remainder of the For Next Loop, all the way down to Next i. Not sure if that's what you want, especially since you'd be setting all letter variables to N/A, then the cells to N/A Might as well just set the cells and cut out the code that sets the variables?

Maybe you should nest the loop in a true/false test like
If Not IsNull(a) Then or perhaps If a <> "" Then and nest the loop inside of that. BTW, the loop omits I and L?

Sometimes the length of time it takes is mostly influenced by the available pc resources.
 
Upvote 0
I have made some changes which may or may not make much difference.
I don't have any of your data and I assume sheet H2H is doing lookups and/or calculations based on the changing in the values of a (L3) & b (S3).

What I tried to do is:
  • Get rid of the select statements
  • Reduce the number of write operations by writing many of the cells out as an array.
    (Your output is skipping some columns. If they are blank and we could write it out as a single array that would help too)
  • Combine the multiple if statements (mentioned by @Micron)
  • Would the If a = "" Then i = 15 be better served by an If a = "" Then Exit For
    What is the intention here ?
VBA Code: 
Sub games_batch_compare()

    Worksheets("Games").Range("C21").Value = "Calculating...."
    
    Application.ScreenUpdating = False
    
    Dim a As Variant, b As Variant, c As Variant, d As Variant, e As Variant, f As Variant, g As Variant, h As Variant
    Dim i As Integer, j As Variant, k As Variant, l As Variant, m As Variant, n As Variant, o As Variant, league As Variant
    
    ' XXX Additional Declarations
    Dim arrOut
    Dim p As Variant, q As Variant
       
    ' make sure selected league from top left matches "SELECT LEAGUE"
    league = Worksheets("Games").Range("D1")
    Worksheets("SELECT LEAGUE").Cells(2, 5).Value = league
    
    For i = 3 To 15
        With Worksheets("Games")
            a = .Cells(i, 3) ' selected Home Team into variable a
            b = .Cells(i, 5) ' selected Away team into variable b
        End With
        
        If a = "" Then i = 15
        
        With Worksheets("H2H")
            .Range("L3").Value = a ' change H2H Home team to variable a
            .Range("S3").Value = b ' change H2H Away team to variable b
            c = .Range("L17") ' declare as home team goals scored
            d = .Range("s18") ' declare as away team Goals scored
            e = .Range("N17") ' declare as home team Goals conceded
            f = .Range("U18") ' declare as away team Goals conceded
            g = .Range("n46") ' declare as clean sheets home
            h = .Range("n52") ' declare as failed to score Home
            j = .Range("u47") ' declare as clean sheets away
            k = .Range("u53") ' declare as failed to score away
            l = .Range("l11") ' declare as home position Overall
            m = .Range("l12") ' declare as home position home
            n = .Range("s13") ' declare as away position away
            o = .Range("s11") ' declare as away position overall
            p = .Range("q206") ' declare as home team points last 4
            q = .Range("Z207") ' declare as away team points last 4
        End With
        
        If a = "" Then
            c = "N/A"
            d = "N/A"
            e = "N/A"
            d = "N/A"
            f = "N/A"
            g = "N/A"
            h = "N/A"
            j = "N/A"
            k = "N/A"
            l = "N/A"
            m = "N/A"
            n = "N/A"
            o = "N/A"
        End If
        
        With Worksheets("Games")
        
            .Cells(i, 7).Value = c ' goals scored H
            .Cells(i, 8).Value = d ' goals scored A
            
            .Cells(i, 10).Value = e ' goals conceded H
            .Cells(i, 11).Value = f ' goals conceded A
            
            arrOut = Array(g, h, j, k, l, m, n, o)
            .Cells(i, 13).Resize(, UBound(arrOut) + 1) = arrOut
        
            .Cells(i, 26).Value = p ' home team points last 4
            .Cells(i, 27).Value = q ' away team points last 4
        End With
    
    Next i
    
    Application.ScreenUpdating = True
    
    Worksheets("Games").Range("C21").Value = "Complete!"

End Sub
 
Upvote 0
Solution
Alex Blakenburg said:
I have made some changes which may or may not make much difference.
I don't have any of your data and I assume sheet H2H is doing lookups and/or calculations based on the changing in the values of a (L3) & b (S3).

What I tried to do is:
  • Get rid of the select statements
  • Reduce the number of write operations by writing many of the cells out as an array.
    (Your output is skipping some columns. If they are blank and we could write it out as a single array that would help too)
  • Combine the multiple if statements (mentioned by @Micron)
  • Would the If a = "" Then i = 15 be better served by an If a = "" Then Exit For
    What is the intention here ?
VBA Code: 
Sub games_batch_compare()

    Worksheets("Games").Range("C21").Value = "Calculating...."
   
    Application.ScreenUpdating = False
   
    Dim a As Variant, b As Variant, c As Variant, d As Variant, e As Variant, f As Variant, g As Variant, h As Variant
    Dim i As Integer, j As Variant, k As Variant, l As Variant, m As Variant, n As Variant, o As Variant, league As Variant
   
    ' XXX Additional Declarations
    Dim arrOut
    Dim p As Variant, q As Variant
      
    ' make sure selected league from top left matches "SELECT LEAGUE"
    league = Worksheets("Games").Range("D1")
    Worksheets("SELECT LEAGUE").Cells(2, 5).Value = league
   
    For i = 3 To 15
        With Worksheets("Games")
            a = .Cells(i, 3) ' selected Home Team into variable a
            b = .Cells(i, 5) ' selected Away team into variable b
        End With
       
        If a = "" Then i = 15
       
        With Worksheets("H2H")
            .Range("L3").Value = a ' change H2H Home team to variable a
            .Range("S3").Value = b ' change H2H Away team to variable b
            c = .Range("L17") ' declare as home team goals scored
            d = .Range("s18") ' declare as away team Goals scored
            e = .Range("N17") ' declare as home team Goals conceded
            f = .Range("U18") ' declare as away team Goals conceded
            g = .Range("n46") ' declare as clean sheets home
            h = .Range("n52") ' declare as failed to score Home
            j = .Range("u47") ' declare as clean sheets away
            k = .Range("u53") ' declare as failed to score away
            l = .Range("l11") ' declare as home position Overall
            m = .Range("l12") ' declare as home position home
            n = .Range("s13") ' declare as away position away
            o = .Range("s11") ' declare as away position overall
            p = .Range("q206") ' declare as home team points last 4
            q = .Range("Z207") ' declare as away team points last 4
        End With
       
        If a = "" Then
            c = "N/A"
            d = "N/A"
            e = "N/A"
            d = "N/A"
            f = "N/A"
            g = "N/A"
            h = "N/A"
            j = "N/A"
            k = "N/A"
            l = "N/A"
            m = "N/A"
            n = "N/A"
            o = "N/A"
        End If
       
        With Worksheets("Games")
       
            .Cells(i, 7).Value = c ' goals scored H
            .Cells(i, 8).Value = d ' goals scored A
           
            .Cells(i, 10).Value = e ' goals conceded H
            .Cells(i, 11).Value = f ' goals conceded A
           
            arrOut = Array(g, h, j, k, l, m, n, o)
            .Cells(i, 13).Resize(, UBound(arrOut) + 1) = arrOut
       
            .Cells(i, 26).Value = p ' home team points last 4
            .Cells(i, 27).Value = q ' away team points last 4
        End With
   
    Next i
   
    Application.ScreenUpdating = True
   
    Worksheets("Games").Range("C21").Value = "Complete!"

End Sub
Click to expand...

Right, thanks for this, just ran my original code which actually took 1m 38s (didn't realise it was that long). Your code immediately took it down to 1m flat.

The skipped columns are due to there being formulas to 'crunch' some of the data imported.

The "if A" etc code is basically for if the table is empty, I thought changing i to 15 would then just skip the process.

I tried more explicitly declaring the variables as either Double or Integer as required but it kept throwing errors surprisingly so I've kept them as Variants.

Thanks again though, huge increase in efficiency, much appreciated. I use this sheet quite regularly but have moved on from learning VBA to Web Development so still unsure on a fair bit of code which could be useful. I don't need to know much more though so your help is very much appreciated.
 
Upvote 0
Micron said:
Nothing obvious to me re: taking too long. However,
- you have a couple of undeclared variables (p & q)
- might be faster if so many variables were not variants
- If a = "" Then i = 15 is supposed to stop code execution, it won't. The counter will then be 15 but will still process the remainder of the For Next Loop, all the way down to Next i. Not sure if that's what you want, especially since you'd be setting all letter variables to N/A, then the cells to N/A Might as well just set the cells and cut out the code that sets the variables?

Maybe you should nest the loop in a true/false test like
If Not IsNull(a) Then or perhaps If a <> "" Then and nest the loop inside of that. BTW, the loop omits I and L?

Sometimes the length of time it takes is mostly influenced by the available pc resources.
Click to expand...
The variables are declared now, good point. As per my other reply in this thread though declaring Integers and Doubles where necessary just didn't work.

Yea, my "If a =" etc code definetly isn't my finest work lol

My work PC is quite decently specced so wouldnt have thought that would be the issue but it is a few years old so maybe. Try not to have anything running in the background.

Not sure if I know enough about nesting and true/false tests in VBA (I understand the concept just not too familar with the syntax in VBA) to implement that unfortunately.

Thanks for your help though, much appreciated.
 
Upvote 0
Thanks for letting us know how you went and glad that it helped a little.
I know you don't want to spend too much more time on it but in the previous I only reduced the write operation a bit, if you make the below changes you could reduce the read operations as well.
eg in a row (or column) pull all the cells you need to copy into a single contiguous range.
You can then read that range in a single operation into an array and use that in your code (instead of the current 14 read operations)

Note: for testing I found it easier to put the value L17 into the cell L17 so the below will look a bit odd but H2 has the formula "=L17" in it.

20220207 VBA Simple assignment speed up.xlsm
ABCDEFGHIJKLMNOPQRSTU
1Consolidate Cells to Copyvariable name --->cdefghjklmnopQ
2formulas to pull them together --->L17S18N17U18N46N52U47U53L11I12S13S11Q206Z207
H2H
Cell Formulas
RangeFormula
H2,J2H2=L17
I2,K2I2=S18
L2L2=N46
M2M2=N52
N2N2=U47
O2O2=U53
P2P2=L11
R2R2=S13
S2S2=S11
T2T2=Q206
U2U2=Z207


The at the top of the code add:-
VBA Code: 
    Dim arrSrc() As Variant
    Dim z As Long

and replace the c = ... d = ... section with this:

VBA Code: 
        With Worksheets("H2H")
            .Range("L3").Value = a ' change H2H Home team to variable a
            .Range("S3").Value = b ' change H2H Away team to variable b
          
            arrSrc = .Range("H2:U2").Value
            z = 1
            c = arrSrc(1, z): z = z + 1      ' declare as home team goals scored
            d = arrSrc(1, z): z = z + 1      ' declare as away team Goals scored
            e = arrSrc(1, z): z = z + 1      ' declare as home team Goals conceded
            f = arrSrc(1, z): z = z + 1      ' declare as away team Goals conceded
            g = arrSrc(1, z): z = z + 1      ' declare as clean sheets home
            h = arrSrc(1, z): z = z + 1      ' declare as failed to score Home
            j = arrSrc(1, z): z = z + 1      ' declare as clean sheets away
            k = arrSrc(1, z): z = z + 1      ' declare as failed to score away
            l = arrSrc(1, z): z = z + 1      ' declare as home position Overall
            m = arrSrc(1, z): z = z + 1      ' declare as home position home
            n = arrSrc(1, z): z = z + 1      ' declare as away position away
            o = arrSrc(1, z): z = z + 1      ' declare as away position overall
            p = arrSrc(1, z): z = z + 1      ' declare as home team points last 4
            q = arrSrc(1, z)                 ' declare as away team points last 4
        End With

Hmm a couple of the formulas appear a bit odd in the XL2BB, with 2 lots seeming to have the same cell reference, this is not the case they are pulling in the cells in the same order as your c to q
 
Upvote 0
Alex Blakenburg said:
Thanks for letting us know how you went and glad that it helped a little.
I know you don't want to spend too much more time on it but in the previous I only reduced the write operation a bit, if you make the below changes you could reduce the read operations as well.
eg in a row (or column) pull all the cells you need to copy into a single contiguous range.
You can then read that range in a single operation into an array and use that in your code (instead of the current 14 read operations)

Note: for testing I found it easier to put the value L17 into the cell L17 so the below will look a bit odd but H2 has the formula "=L17" in it.

20220207 VBA Simple assignment speed up.xlsm
ABCDEFGHIJKLMNOPQRSTU
1Consolidate Cells to Copyvariable name --->cdefghjklmnopQ
2formulas to pull them together --->L17S18N17U18N46N52U47U53L11I12S13S11Q206Z207
H2H
Cell Formulas
RangeFormula
H2,J2H2=L17
I2,K2I2=S18
L2L2=N46
M2M2=N52
N2N2=U47
O2O2=U53
P2P2=L11
R2R2=S13
S2S2=S11
T2T2=Q206
U2U2=Z207


The at the top of the code add:-
VBA Code: 
    Dim arrSrc() As Variant
    Dim z As Long

and replace the c = ... d = ... section with this:

VBA Code: 
        With Worksheets("H2H")
            .Range("L3").Value = a ' change H2H Home team to variable a
            .Range("S3").Value = b ' change H2H Away team to variable b
         
            arrSrc = .Range("H2:U2").Value
            z = 1
            c = arrSrc(1, z): z = z + 1      ' declare as home team goals scored
            d = arrSrc(1, z): z = z + 1      ' declare as away team Goals scored
            e = arrSrc(1, z): z = z + 1      ' declare as home team Goals conceded
            f = arrSrc(1, z): z = z + 1      ' declare as away team Goals conceded
            g = arrSrc(1, z): z = z + 1      ' declare as clean sheets home
            h = arrSrc(1, z): z = z + 1      ' declare as failed to score Home
            j = arrSrc(1, z): z = z + 1      ' declare as clean sheets away
            k = arrSrc(1, z): z = z + 1      ' declare as failed to score away
            l = arrSrc(1, z): z = z + 1      ' declare as home position Overall
            m = arrSrc(1, z): z = z + 1      ' declare as home position home
            n = arrSrc(1, z): z = z + 1      ' declare as away position away
            o = arrSrc(1, z): z = z + 1      ' declare as away position overall
            p = arrSrc(1, z): z = z + 1      ' declare as home team points last 4
            q = arrSrc(1, z)                 ' declare as away team points last 4
        End With

Hmm a couple of the formulas appear a bit odd in the XL2BB, with 2 lots seeming to have the same cell reference, this is not the case they are pulling in the cells in the same order as your c to q
Click to expand...
Nice one, I've managed to copy and paste that all in, not much difference unfortunately. Shame, as some really nice code.

Thinking about it the biggest issue must be collecting the data. Even though this Macro pulls data from elsewhere in the same book (the 'working' Workbook) it relies on another seperate Workbook (the Data only workbook) to be open.

I'm not sure how it works as I didn't create the original book (half of the 'working' book I've been working on) but if the other 'Data' Workbook isn't open in the background all the data in the working book is blank (which I extract the data from). Once I 'select league' the data in the working book stays the same so didn't think it would matter but I guess it does.

Thanks again for your help though. Still got it down to almost twice as quick.
 
Upvote 0
Thank you for providing, the results of you testing and the addional external link information.
I am not a big fan of linking sheets, it tends to slow down the spreadsheet and I prefer to use a snapshot in time, so I have a reference point that I can go back to and not have it linked to something that may or may not have changed.
 
Upvote 0
Alex Blakenburg said:
Thank you for providing, the results of you testing and the addional external link information.
I am not a big fan of linking sheets, it tends to slow down the spreadsheet and I prefer to use a snapshot in time, so I have a reference point that I can go back to and not have it linked to something that may or may not have changed.
Click to expand...
No problem, yea me too, I'm happy to import data. Always thought it was strange to need to have another file open permanently alongside it.
 
Upvote 0
@steveh8204 Give this one a try if you don't mind:

VBA Code: 
Sub games_batch_compareV2()
'
    Dim startTime                   As Single
'
    startTime = Timer                                                                       ' Start the Stop watch
'
    Application.ScreenUpdating = False                                                      ' Turn ScreenUpdating off
'
    Dim a As Variant, b As Variant, c As Variant, d As Variant, e As Variant, f As Variant, g As Variant, h As Variant
    Dim i As Integer, j As Variant, k As Variant, l As Variant, m As Variant, n As Variant, o As Variant
    Dim league          As Variant
'
    Dim H2H_CombinedRangesArray As Collection
    Dim TeamLastRow             As Long, TeamStartRow   As Long
    Dim GamesArray1             As Variant, GamesArray2 As Variant, GamesArray3 As Variant, GamesArray4 As Variant, GamesArray5 As Variant
    Dim TeamsArray              As Variant, H2H_Array   As Variant
'
    TeamStartRow = 3                                                                        ' <--- Set this to the row # that the teams start on
    TeamLastRow = Sheets("Games").Range("C" & TeamStartRow).End(xlDown).Row                 ' Returns Row # the teams end on
'
    GamesArray1 = Sheets("Games").Range("G" & TeamStartRow & ":H" & TeamLastRow)
    GamesArray2 = Sheets("Games").Range("J" & TeamStartRow & ":K" & TeamLastRow)
    GamesArray3 = Sheets("Games").Range("M" & TeamStartRow & ":N" & TeamLastRow)
    GamesArray4 = Sheets("Games").Range("O" & TeamStartRow & ":T" & TeamLastRow)
    GamesArray5 = Sheets("Games").Range("Z" & TeamStartRow & ":AA" & TeamLastRow)
'
    TeamsArray = Sheets("Games").Range("C" & TeamStartRow & ":E" & TeamLastRow)             ' Load Teams into TeamsArray
    
    Sheets("Games").Range("C21").Value = "Calculating...."                                  ' Set Sheets("Games").Range("C21") = "Calculating...."
'
'   make sure selected league from top left matches "SELECT LEAGUE"
    Sheets("SELECT LEAGUE").Cells(2, 5).Value = Sheets("Games").Range("D1")             ' Sheets("SELECT LEAGUE").Range("E2") = Sheets("Games").Range("D1")
'
    Set H2H_CombinedRangesArray = New Collection
'
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("L17:L17")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("S18:S18")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("N17:N17")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("U18:U18")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("N46:N46")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("N52:N52")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("U47:U47")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("U53:U53")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("L11:L11")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("L12:L12")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("S13:S13")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("S11:S11")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("Q206:Q206")
    H2H_CombinedRangesArray.Add Sheets("H2H").Range("Z207:Z207")
'
    H2H_Array = CollectionToArray(H2H_CombinedRangesArray)          ' Transfer H2H_CombinedRangesArray to 1D zero based array using function CollectionToArray
'
''    For i = TeamStartRow To TeamLastRow                                                     ' Loop through row #s 3 to TeamLastRow
    For i = LBound(TeamsArray, 1) To UBound(TeamsArray, 1)                                  ' Loop through row #s 3 to 15 of Sheets("Games")
        GamesArray1(i, 1) = H2H_Array(0)                                ' Set Sheets("Games").Range("G" & 3,4,5,etc) = c    goals scored Home
        GamesArray1(i, 2) = H2H_Array(1)                                ' Set Sheets("Games").Range("H" & 3,4,5,etc) = d    goals scored Away
'
        GamesArray2(i, 1) = H2H_Array(2)                                ' Set Sheets("Games").Range("J" & 3,4,5,etc) = e    goals conceded Home
        GamesArray2(i, 2) = H2H_Array(3)                                ' Set Sheets("Games").Range("K" & 3,4,5,etc) = f    goals conceded Away
'
        GamesArray3(i, 1) = H2H_Array(4)                                ' Set Sheets("Games").Range("M" & 3,4,5,etc) = g    clean sheets home
        GamesArray3(i, 2) = H2H_Array(5)                                ' Set Sheets("Games").Range("N" & 3,4,5,etc) = h    failed to score Home
'
        GamesArray4(i, 1) = H2H_Array(6)                                ' Set Sheets("Games").Range("O" & 3,4,5,etc) = j    clean sheets away
        GamesArray4(i, 2) = H2H_Array(7)                                ' Set Sheets("Games").Range("P" & 3,4,5,etc) = k    failed to score Away
        GamesArray4(i, 3) = H2H_Array(8)                                ' Set Sheets("Games").Range("Q" & 3,4,5,etc) = l    home position overall
        GamesArray4(i, 4) = H2H_Array(9)                                ' Set Sheets("Games").Range("R" & 3,4,5,etc) = m    home position home
        GamesArray4(i, 5) = H2H_Array(10)                               ' Set Sheets("Games").Range("S" & 3,4,5,etc) = n    away position away
        GamesArray4(i, 6) = H2H_Array(11)                               ' Set Sheets("Games").Range("T" & 3,4,5,etc) = o    away position overall
'
        GamesArray5(i, 1) = H2H_Array(12)                               ' Set Sheets("Games").Range("Z" & 3,4,5,etc) = p    home team points last 4
        GamesArray5(i, 2) = H2H_Array(13)                               ' Set Sheets("Games").Range("AA" & 3,4,5,etc) = q   away team points last 4
    Next
'
    Sheets("H2H").Range("L3").Value = TeamsArray(i - 1, 1)              ' Solution to Pointless writing because final result is the last value of a
    Sheets("H2H").Range("S3").Value = TeamsArray(i - 1, 3)              ' Solution to Pointless writing because final result is the last value of b
'
    Sheets("Games").Range("G" & TeamStartRow & ":H" & TeamLastRow) = GamesArray1
    Sheets("Games").Range("J" & TeamStartRow & ":K" & TeamLastRow) = GamesArray2
    Sheets("Games").Range("M" & TeamStartRow & ":N" & TeamLastRow) = GamesArray3
    Sheets("Games").Range("O" & TeamStartRow & ":T" & TeamLastRow) = GamesArray4
    Sheets("Games").Range("Z" & TeamStartRow & ":AA" & TeamLastRow) = GamesArray5

    Sheets("Games").Range("C21").Value = "Complete!"                    ' Sheets("Games").Range("C21") = "Complete!"
'
    Application.ScreenUpdating = True                                   ' Turn ScreenUpdating back on
'
    Debug.Print "Time to complete = " & Timer - startTime & " seconds." ' Display the time elapsed to the user (Ctrl-G)
End Sub


Function CollectionToArray(col As Collection) As Variant()
'
    Dim arr()   As Variant
    Dim index   As Long
    Dim it      As Variant
'
    ReDim arr(col.Count - 1) As Variant
'
    For Each it In col
        arr(index) = it
        index = index + 1
    Next it
'
    CollectionToArray = arr
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
create fixtures but 2 vs 2
Replies
7
Views
171
kerm007
K
A
  • Solved
Football predictions v Actual score
Replies
3
Views
407
Axdby
A
A
  • Solved
Extract and Merge Files
Replies
1
Views
133
rowebca
rowebca
A
  • Solved
VBA code to extract a table
Replies
5
Views
283
Anthony47
A
C
  • Question Question
Excel - Countif by Cell Value AND Cell Color
Replies
1
Views
671
awoohaw
awoohaw

Forum statistics

Threads
1,224,557
Messages
6,179,508
Members
452,918
Latest member
Davion615

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top