Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Possible to speed up Macro Calculation?

Posted on 2011-10-15
11
Medium Priority
?
185 Views
Last Modified: 2012-05-12
Hi,

I have a macro

Sub test()

Sheets("Table").Select
    Range("U1").FormulaR1C1 = "=NOW()"
    Range("U1").Value = Range("U1").Value
    


Range("c1").Select


Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual

''''''''''' Copying different Team combinations to Sheet 2

For A1 = 1 To 14


Sheet2.Range("c1:c40").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
ActiveCell.Offset(40, -A1).Select


    For A2 = 1 To 14
    ActiveCell.Offset(0, 1).Select
    Sheet2.Range("C41:C80").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
    ActiveCell.Offset(40, -A2).Select
    
    
        For A3 = 1 To 14
        ActiveCell.Offset(0, 1).Select
        Sheet2.Range("C81:C120").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
        ActiveCell.Offset(40, -A3).Select
        
            For A4 = 1 To 14
            ActiveCell.Offset(0, 1).Select
            Sheet2.Range("C121:C160").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
            ActiveCell.Offset(40, -A4).Select
            
                For A5 = 1 To 14
                ActiveCell.Offset(0, 1).Select
                Sheet2.Range("C161:C200").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                ActiveCell.Offset(40, -A5).Select
                                         
                    For A6 = 1 To 14
                    ActiveCell.Offset(0, 1).Select
                    Sheet2.Range("C201:C240").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                    ActiveCell.Offset(40, -A6).Select
                
                        For A7 = 1 To 14
                        ActiveCell.Offset(0, 1).Select
                        Sheet2.Range("C241:C280").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                        ActiveCell.Offset(40, -A7).Select
                
                            For A8 = 1 To 14
                            ActiveCell.Offset(0, 1).Select
                            Sheet2.Range("C281:C320").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                            ActiveCell.Offset(40, -A8).Select
                
                                For A9 = 1 To 14
                                ActiveCell.Offset(0, 1).Select
                                Sheet2.Range("C321:C360").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                ActiveCell.Offset(40, -A9).Select
                
                                    For A10 = 1 To 14
                                    ActiveCell.Offset(0, 1).Select
                                    Sheet2.Range("C361:C400").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                    ActiveCell.Offset(40, -A10).Select
                                                
                                        For A11 = 1 To 14
                                        ActiveCell.Offset(0, 1).Select
                                        Sheet2.Range("C401:C440").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                        ActiveCell.Offset(40, -A11).Select
                                
                                            For A12 = 1 To 14
                                            ActiveCell.Offset(0, 1).Select
                                            Sheet2.Range("C441:C480").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                            ActiveCell.Offset(40, -A12).Select
                
                                                For A13 = 1 To 14
                                                ActiveCell.Offset(0, 1).Select
                                                Sheet2.Range("C481:C520").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                ActiveCell.Offset(40, -A13).Select
                                
                                                    For A14 = 1 To 14
                                                    ActiveCell.Offset(0, 1).Select
                                                    Sheet2.Range("C521:C560").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                    ActiveCell.Offset(40, -A14).Select
                                
                                                        For A15 = 1 To 14
                                                        ActiveCell.Offset(0, 1).Select
                                                        Sheet2.Range("C561:C600").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                        ActiveCell.Offset(40, -A15).Select
                                                        
                                                            For A16 = 1 To 14
                                                            ActiveCell.Offset(0, 1).Select
                                                            Sheet2.Range("C601:C640").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                            ActiveCell.Offset(40, -A16).Select
                
                                                                For A17 = 1 To 14
                                                                ActiveCell.Offset(0, 1).Select
                                                                Sheet2.Range("C641:C680").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                ActiveCell.Offset(40, -A17).Select
                                
                                                                    For A18 = 1 To 14
                                                                    ActiveCell.Offset(0, 1).Select
                                                                    Sheet2.Range("C681:C720").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                    ActiveCell.Offset(40, -A18).Select
                
                                                                        For A19 = 1 To 14
                                                                        ActiveCell.Offset(0, 1).Select
                                                                        Sheet2.Range("C721:C760").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                        ActiveCell.Offset(40, -A19).Select
                
                                                                            For A20 = 1 To 14
                                                                            ActiveCell.Offset(0, 1).Select
                                                                            Sheet2.Range("C761:C800").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                            ActiveCell.Offset(40, -A20).Select
                                                                            
                                                                                For A21 = 1 To 14
                                                                                ActiveCell.Offset(0, 1).Select
                                                                                Sheet2.Range("C801:C840").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                ActiveCell.Offset(40, -A21).Select
                
                                                                                    For A22 = 1 To 14
                                                                                    ActiveCell.Offset(0, 1).Select
                                                                                    Sheet2.Range("C841:C880").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                    ActiveCell.Offset(40, -A22).Select
                
                                                                                        For A23 = 1 To 14
                                                                                        ActiveCell.Offset(0, 1).Select
                                                                                        Sheet2.Range("C881:C920").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                        ActiveCell.Offset(40, -A23).Select
                
                                                                                            For A24 = 1 To 14
                                                                                            ActiveCell.Offset(0, 1).Select
                                                                                            Sheet2.Range("C921:C960").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                            ActiveCell.Offset(40, -A24).Select
                
                              
                              
                              
                
                
                
                
                                                                                                For A25 = 1 To 14
                                                                                                ActiveCell.Offset(0, 1).Select
                                                                                                Sheet2.Range("C961:C1000").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                                'Calculate
                                                                                                        
                                                                                                        If Sheet2.Range("H1") > 5 Then 'If more than 5 Players are not playing, copy them to Sheet3
                                                                                                           
                                                                                                                Sheets("Sheet2").Select
                                                                                                                Range("F1").Select
                                                                                                                
                                                                                                                Do While ActiveCell <> ""
                                                                                                                    If ActiveCell = 0 Then
                                                                                                                        Range(ActiveCell, ActiveCell.Offset(0, -1)).Copy
                                                                                                                        Sheets("Sheet3").Select
                                                                                                                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                                                         :=False, Transpose:=False
                                                                                                                        ActiveCell.Offset(1, 0).Select
                                                                                                                        Sheets("Sheet2").Select
                                                                                                                        ActiveCell.Offset(1, 0).Select
                                                                                                                    Else
                                                                                                                        ActiveCell.Offset(1, 0).Select
                                                                                                                    End If
                                                                                                                        
                                                                                                                Loop
                                                                                                                
                                                                                                                Sheets("Sheet3").Select
                                                                                                                ActiveCell.Offset(2, 0).Select
                                                                                                                Sheets("Table").Select
                                                                                                                
                                                                                                        End If
                                                                                                        
   
   

                                                                                                Next A25
                                                                                                    
                                                                                            
                                                                                            
                                                                                            
                                                                                            
                                                                                            
                                                                                            ActiveCell.Offset(-40, -14 + A24).Select
                                                                                            Next A24
                                                                                                    
                                                                                        ActiveCell.Offset(-40, -14 + A23).Select
                                                                                        Next A23
                                                                                                                                                                                                      
                                                                                    ActiveCell.Offset(-40, -14 + A22).Select
                                                                                    Next A22
                                                                                                    
                                                                                ActiveCell.Offset(-40, -14 + A21).Select
                                                                                Next A21
                                                                                                    
                                                                            ActiveCell.Offset(-40, -14 + A20).Select
                                                                            Next A20
                    
                                                                        ActiveCell.Offset(-40, -14 + A19).Select
                                                                        Next A19
                                                                                                              
                                                                    ActiveCell.Offset(-40, -14 + A18).Select
                                                                    Next A18
                    
                                                                ActiveCell.Offset(-40, -14 + A17).Select
                                                                Next A17
                    
                                                            ActiveCell.Offset(-40, -14 + A16).Select
                                                            Next A16
                    
                                                        ActiveCell.Offset(-40, -14 + A15).Select
                                                        Next A15
                    
                                                    ActiveCell.Offset(-40, -14 + A14).Select
                                                    Next A14
                    
                                                ActiveCell.Offset(-40, -14 + A13).Select
                                                Next A13
                 
                                            ActiveCell.Offset(-40, -14 + A12).Select
                                            Next A12
                    
                                        ActiveCell.Offset(-40, -14 + A11).Select
                                        Next A11
                    
                                    ActiveCell.Offset(-40, -14 + A10).Select
                                    Next A10
                        
                                ActiveCell.Offset(-40, -14 + A9).Select
                                Next A9
                                        
                            ActiveCell.Offset(-40, -14 + A8).Select
                            Next A8
                    
                        ActiveCell.Offset(-40, -14 + A7).Select
                        Next A7
                    
                    ActiveCell.Offset(-40, -14 + A6).Select
                    Next A6
                     
                ActiveCell.Offset(-40, -14 + A5).Select
                Next A5
                
            ActiveCell.Offset(-40, -14 + A4).Select
            Next A4
        
        ActiveCell.Offset(-40, -14 + A3).Select
        Next A3
    
    ActiveCell.Offset(-40, -14 + A2).Select
    Next A2
    
    
ActiveCell.Offset(-40, -14 + A1).Select
ActiveCell.Offset(0, 1).Select
Next A1













'Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Range("U2").FormulaR1C1 = "=NOW()"
Range("U2").Value = Range("U2").Value

End Sub

Open in new window



The purpose is to caculate all 4499879580584837311451522624 combinations
(14 x 14 x 14 x 14......14)
<<14^25>>

However, I realize with my computer's speed (Intel Q9300), it is probably impossible to EVER finish running that many combinations.

Therefore, I am just wondering if I can do anything to make the code more efficiently? or it's just impossible to test 14 to the power of 25 combinations with a normal desktop computer?

To provide a better idea, the question is also attached with the workbook which included the macro.


Below is the backgroud to the workbook uploaded:

((To me, this is pretty much an IMPOSSIBLE-TO-SOLVE question that was given out as a bonus question for the term. ))

The question is:
There are 25 Teams in Sheet "Table" in the workbook (Team A ~ Team Y)
Each team, there are 14 configurations
(eg. Team A-1, Team A-2...Team A-14)
Team B-1, Team B-2...Team B-14....and so on..)

In every game, all 25 teams picks a confiugation to play.
eg.
Game1: Team A-1, Team B-1, Team C-1... Team Y-1
Game2: Team A-1, Team B-1, Team C-1... Team Y-2
Game4499879580584837114515226624: Team A-14, Team B-14, Team C-14....Team Y14)

Out of all the games (combinations), most if not all player should be playing.
However, he said there are few games with 5 or more players NOT playing at all.

Our job is to figure out which players they are.

Hence all the FOR/LOOP in the macro to test out all the combinations.

Is it even possible at all ? Or maybe only a supercomputer can do it? Or is there a smarter approach to it that I am not seeing?

Please help and thanks a lot =)

***P.S. IF it's not possible at all, I would be glad to hear from all experts as well. Any input is appreciated. THANKS =) ****

Experts-Exchange-Question.xlsm
0
Comment
Question by:Starbucksss
  • 5
  • 4
  • 2
11 Comments
 
LVL 37

Expert Comment

by:TommySzalapski
ID: 36973378
No, there is no possible way to test that many combinations even with a supercomputer. If you have 1 billion computers with quad-core 5 gigahertz processors and it took only 1 line of machine code to check one combination it would still take 57 years to do all of them.

You have to solve it by being clever not testing every combination.

There is data missing so we can't help you much yet. How are the players arranged in the team? If you post the rest of the question, we can help you figure out the trick that lets you solve it.
0
 

Author Comment

by:Starbucksss
ID: 36973396
Hi Tommy,

Thanks for the prompt reply.
As far as I know, I am not aware of any special arrangement for the teams/members. However, maybe I will ask the prof for further information.

So, as far as coding goes, or solving questions like this with only the information given, there is no other approachs other than testing out EVERY COMBINATION (which will take forever even with the most efficient coding?)?

Thanks
0
 
LVL 37

Expert Comment

by:TommySzalapski
ID: 36973456
No. With the information given, you can't do anything.

If you set it up with every possible combination, each team configuration will appear the exact same number of times. What would you test the combinations for? There's nothing to solve.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 

Author Comment

by:Starbucksss
ID: 36974465
Hi Tommy,

Thanks again for the reply.again :)

I believe whatt the professor is asking for is:
Out of all the combinations, there are combinations where 5 or more players are not playing. That's why, what I am doing right now is, copying each combination to Sheet2, and then do a countif on every player. If there are more than 5 players with 0 countif, then they are the answer that the prof is looking for.

thanks :)
0
 
LVL 37

Expert Comment

by:TommySzalapski
ID: 36974472
How do you know which players are playing?
0
 

Author Comment

by:Starbucksss
ID: 36974670
Hi Tommy,

Not sure if you downloaded the original excel attached to the original post or not. if not, I have updated the workbook to make it neater looking after asking prof some questions.

But to answer your question, the players are predetermined/arranged by the prof. I am not sure what algorithm he uses to generate the player list. But he within this list, basically there are will be combinations where 5 or more players are not active. He wants us to figure out which ones they are.

In the workbook/macro,
baiscally what I have done is to copy Team A-1, Team B-1......Team Y-1 to Sheet2. And then I do a countif of the whole colmn with players' name (the copied data) and see how many players are with 0. If there are 5 or more players with "0", i then copy their names to Sheet3.

That's pretty much my approach and what the macro is about.

Once aainn, thahnks for helpng out.

Sub test()

Sheets("Sheet1").Select
    Range("U1").FormulaR1C1 = "=NOW()"
    Range("U1").Value = Range("U1").Value
    


Range("c1").Select


Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual

''''''''''' Copying different Team combinations to Sheet 2

For A1 = 1 To 14


Sheet2.Range("c1:c40").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
ActiveCell.Offset(40, -A1).Select


    For A2 = 1 To 14
    ActiveCell.Offset(0, 1).Select
    Sheet2.Range("C41:C80").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
    ActiveCell.Offset(40, -A2).Select
    
    
        For A3 = 1 To 14
        ActiveCell.Offset(0, 1).Select
        Sheet2.Range("C81:C120").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
        ActiveCell.Offset(40, -A3).Select
        
            For A4 = 1 To 14
            ActiveCell.Offset(0, 1).Select
            Sheet2.Range("C121:C160").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
            ActiveCell.Offset(40, -A4).Select
            
                For A5 = 1 To 14
                ActiveCell.Offset(0, 1).Select
                Sheet2.Range("C161:C200").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                ActiveCell.Offset(40, -A5).Select
                                         
                    For A6 = 1 To 14
                    ActiveCell.Offset(0, 1).Select
                    Sheet2.Range("C201:C240").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                    ActiveCell.Offset(40, -A6).Select
                
                        For A7 = 1 To 14
                        ActiveCell.Offset(0, 1).Select
                        Sheet2.Range("C241:C280").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                        ActiveCell.Offset(40, -A7).Select
                
                            For A8 = 1 To 14
                            ActiveCell.Offset(0, 1).Select
                            Sheet2.Range("C281:C320").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                            ActiveCell.Offset(40, -A8).Select
                
                                For A9 = 1 To 14
                                ActiveCell.Offset(0, 1).Select
                                Sheet2.Range("C321:C360").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                ActiveCell.Offset(40, -A9).Select
                
                                    For A10 = 1 To 14
                                    ActiveCell.Offset(0, 1).Select
                                    Sheet2.Range("C361:C400").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                    ActiveCell.Offset(40, -A10).Select
                                                
                                        For A11 = 1 To 14
                                        ActiveCell.Offset(0, 1).Select
                                        Sheet2.Range("C401:C440").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                        ActiveCell.Offset(40, -A11).Select
                                
                                            For A12 = 1 To 14
                                            ActiveCell.Offset(0, 1).Select
                                            Sheet2.Range("C441:C480").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                            ActiveCell.Offset(40, -A12).Select
                
                                                For A13 = 1 To 14
                                                ActiveCell.Offset(0, 1).Select
                                                Sheet2.Range("C481:C520").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                ActiveCell.Offset(40, -A13).Select
                                
                                                    For A14 = 1 To 14
                                                    ActiveCell.Offset(0, 1).Select
                                                    Sheet2.Range("C521:C560").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                    ActiveCell.Offset(40, -A14).Select
                                
                                                        For A15 = 1 To 14
                                                        ActiveCell.Offset(0, 1).Select
                                                        Sheet2.Range("C561:C600").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                        ActiveCell.Offset(40, -A15).Select
                                                        
                                                            For A16 = 1 To 14
                                                            ActiveCell.Offset(0, 1).Select
                                                            Sheet2.Range("C601:C640").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                            ActiveCell.Offset(40, -A16).Select
                
                                                                For A17 = 1 To 14
                                                                ActiveCell.Offset(0, 1).Select
                                                                Sheet2.Range("C641:C680").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                ActiveCell.Offset(40, -A17).Select
                                
                                                                    For A18 = 1 To 14
                                                                    ActiveCell.Offset(0, 1).Select
                                                                    Sheet2.Range("C681:C720").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                    ActiveCell.Offset(40, -A18).Select
                
                                                                        For A19 = 1 To 14
                                                                        ActiveCell.Offset(0, 1).Select
                                                                        Sheet2.Range("C721:C760").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                        ActiveCell.Offset(40, -A19).Select
                
                                                                            For A20 = 1 To 14
                                                                            ActiveCell.Offset(0, 1).Select
                                                                            Sheet2.Range("C761:C800").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                            ActiveCell.Offset(40, -A20).Select
                                                                            
                                                                                For A21 = 1 To 14
                                                                                ActiveCell.Offset(0, 1).Select
                                                                                Sheet2.Range("C801:C840").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                ActiveCell.Offset(40, -A21).Select
                
                                                                                    For A22 = 1 To 14
                                                                                    ActiveCell.Offset(0, 1).Select
                                                                                    Sheet2.Range("C841:C880").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                    ActiveCell.Offset(40, -A22).Select
                
                                                                                        For A23 = 1 To 14
                                                                                        ActiveCell.Offset(0, 1).Select
                                                                                        Sheet2.Range("C881:C920").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                        ActiveCell.Offset(40, -A23).Select
                
                                                                                            For A24 = 1 To 14
                                                                                            ActiveCell.Offset(0, 1).Select
                                                                                            Sheet2.Range("C921:C960").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                            ActiveCell.Offset(40, -A24).Select
                
                              
                              
                              
                
                
                
                
                                                                                                For A25 = 1 To 14
                                                                                                ActiveCell.Offset(0, 1).Select
                                                                                                Sheet2.Range("C961:C1000").Value = Sheet1.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(39, 0)).Value
                                                                                                'Calculate
                                                                                                        
                                                                                                        If Sheet2.Range("H1") > 5 Then 'If more than 5 Players are not playing, copy them to Sheet3
                                                                                                           
                                                                                                                Sheets("Sheet2").Select
                                                                                                                Range("F1").Select
                                                                                                                
                                                                                                                Do While ActiveCell <> ""
                                                                                                                    If ActiveCell = 0 Then
                                                                                                                        Range(ActiveCell, ActiveCell.Offset(0, -1)).Copy
                                                                                                                        Sheets("Sheet3").Select
                                                                                                                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                                                         :=False, Transpose:=False
                                                                                                                        ActiveCell.Offset(1, 0).Select
                                                                                                                        Sheets("Sheet2").Select
                                                                                                                        ActiveCell.Offset(1, 0).Select
                                                                                                                    Else
                                                                                                                        ActiveCell.Offset(1, 0).Select
                                                                                                                    End If
                                                                                                                        
                                                                                                                Loop
                                                                                                                
                                                                                                                Sheets("Sheet3").Select
                                                                                                                ActiveCell.Offset(2, 0).Select
                                                                                                                Sheets("Table").Select
                                                                                                                
                                                                                                        End If
                                                                                                        
   
   

                                                                                                Next A25
                                                                                                    
                                                                                            
                                                                                            
                                                                                            
                                                                                            
                                                                                            
                                                                                            ActiveCell.Offset(-40, -14 + A24).Select
                                                                                            Next A24
                                                                                                    
                                                                                        ActiveCell.Offset(-40, -14 + A23).Select
                                                                                        Next A23
                                                                                                                                                                                                      
                                                                                    ActiveCell.Offset(-40, -14 + A22).Select
                                                                                    Next A22
                                                                                                    
                                                                                ActiveCell.Offset(-40, -14 + A21).Select
                                                                                Next A21
                                                                                                    
                                                                            ActiveCell.Offset(-40, -14 + A20).Select
                                                                            Next A20
                    
                                                                        ActiveCell.Offset(-40, -14 + A19).Select
                                                                        Next A19
                                                                                                              
                                                                    ActiveCell.Offset(-40, -14 + A18).Select
                                                                    Next A18
                    
                                                                ActiveCell.Offset(-40, -14 + A17).Select
                                                                Next A17
                    
                                                            ActiveCell.Offset(-40, -14 + A16).Select
                                                            Next A16
                    
                                                        ActiveCell.Offset(-40, -14 + A15).Select
                                                        Next A15
                    
                                                    ActiveCell.Offset(-40, -14 + A14).Select
                                                    Next A14
                    
                                                ActiveCell.Offset(-40, -14 + A13).Select
                                                Next A13
                 
                                            ActiveCell.Offset(-40, -14 + A12).Select
                                            Next A12
                    
                                        ActiveCell.Offset(-40, -14 + A11).Select
                                        Next A11
                    
                                    ActiveCell.Offset(-40, -14 + A10).Select
                                    Next A10
                        
                                ActiveCell.Offset(-40, -14 + A9).Select
                                Next A9
                                        
                            ActiveCell.Offset(-40, -14 + A8).Select
                            Next A8
                    
                        ActiveCell.Offset(-40, -14 + A7).Select
                        Next A7
                    
                    ActiveCell.Offset(-40, -14 + A6).Select
                    Next A6
                     
                ActiveCell.Offset(-40, -14 + A5).Select
                Next A5
                
            ActiveCell.Offset(-40, -14 + A4).Select
            Next A4
        
        ActiveCell.Offset(-40, -14 + A3).Select
        Next A3
    
    ActiveCell.Offset(-40, -14 + A2).Select
    Next A2
    
    
ActiveCell.Offset(-40, -14 + A1).Select
ActiveCell.Offset(0, 1).Select
Next A1













'Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Range("U2").FormulaR1C1 = "=NOW()"
Range("U2").Value = Range("U2").Value

End Sub

Open in new window



I have also uploaded the workbook to google document. The data looks pretty much like that. Each confirguation is 1 column, 40 rows. However, with excel on google document, the format is lost, so it's not as neat looking. But the data's all the same.


 The attached file is the same as the onen in google documents WITH the formatting. So it's easier to read.

Thanks

.
Experts-Exchange-Question.xlsm
0
 
LVL 37

Accepted Solution

by:
TommySzalapski earned 2000 total points
ID: 36974794
Okay. I get the problem now.

Going through every possible combination clearly won't work since it would take hundreds of years. Here's a better way of doing the problem.

Take each player one at a time. Then search through each team and find all configurations which exclude that player. If there exist configurations in every team which exclude that player, then those are the potential configurations that could exclude 5 or more players.

Another way to approach it is to look at all possible groupings of 5 players (there are 'only' 2118760) and compare each of those to the list of teams. That will still take some time, but exponentially less than the figure for total possible combinations.

I am a bit confused by your spreadsheet. The way I read it, team A-6 has Darren and Vincent both in it twice. This happens in many teams. Also, by the pigeon hole principle, every possible combination has to have at least one person on multiple teams. I suppose this is fine.
0
 
LVL 46

Expert Comment

by:aikimark
ID: 36976497
What do the four groups of names signify?

I'd take similar approach to Tommy.  My approach would be to use a dictionary object to store the unique names for each week and look at the .Count property as the determinant for which week is short.  Use the .RemoveAll method to clear the dictionary object between weeks.
0
 
LVL 37

Expert Comment

by:TommySzalapski
ID: 36980938
I don't get what you (aikimark) are doing with weeks and short weeks.

I wouldn't use a dictionary object, I would just use a big 2D array with a column for each player and a row for each team configuration. I would also use C++ instead of Excel since that would make it take much less time to run.

Since this is for a bonus question, it wouldn't be right to give you (Starbucksss) too much help. If you want, though, I can confirm if I get the same answer and give some more direction if needed.
0
 
LVL 46

Expert Comment

by:aikimark
ID: 36981282
@Tommy

I really don't understand the data, so I might be really off base.  A short week is one with fewer unique players.  I suggested the use of a dictionary object, since its Exists() method facilitates the unique item constraint quite efficiently.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question