Macro for copy ranges

B

BioPA

New Member
Joined
Oct 26, 2013
Messages
30
Hi there!

I am really embarrassed that currently i don't have the skills to start posting replies but only asking for support!

Well, if someone could contribute to this, i would be very grateful:

Think about 2 men who play a game. Each player has multiple scores within a set ranging from 0 to 1. Each time the RAND() cell value is below than their score, a point is credited. Each set of scores is not standard and the number of scores of each player could vary.

I would like to simulate this set a thousand times and then have the frequencies of the expected points.

I give you an example:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B (THEIR SCORE)[/TD]
[TD]C (RAND())[/TD]
[TD]Point (1=yes, 0=no)[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]MARK[/TD]
[TD]0.500[/TD]
[TD]0.745[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]TONY[/TD]
[TD]0.254[/TD]
[TD]0.145[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]MARK[/TD]
[TD]0.369[/TD]
[TD]0.201[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]MARK[/TD]
[TD]0.471[/TD]
[TD]0.578[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]TONY[/TD]
[TD]0.210[/TD]
[TD]0.110[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]MARK[/TD]
[TD]0.150[/TD]
[TD]0.048[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]

TONY - MARK : 2-2 RESULT: DRAW

Now, i would like to simulate the above range of scores 1000 times (copy it 1000 times) and
have a summary of the possible scores between the two players:

0-0: 1%
1-0: 5%
1-1: 10%
2-1: 25%
2-2: 30%
3-2: 15%
3-3: 7%
4-3: 5%
4-4: 2%

Any help?
 
Last edited:

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
B column's values are manually typed
C column's values is a result of =RAND() FORMULA

Thank you
 
Upvote 0
BioPA said:
B column's values are manually typed
C column's values is a result of =RAND() FORMULA

Thank you
Click to expand...


Alright, so I think I'm on the right track for what you want here. I put this together and tested it to be sure it works. With RAND in place, the macro turns off calculations mid-run to grab the current totals before purposely triggering the reset.

Code: 
Sub Collect()
'This macro will run 1000 scripts and provide statistics as requested
'Cell L2 has been set as the Run Total for counting measures
'H2 captures Marks total score
'H3 captures Tonys total score
Dim Runcount As Integer
Dim Mark As Integer
Dim Tony As Integer
Dim Score As String
Dim ScoreSet As String
Dim ScorePlus As Integer
Dim Dash As String
Application.ScreenUpdating = False
Dash = (Chr(45))
Range("L2").Value = 0
Range("H5:H25").Select
Selection.ClearContents
Runcount = Range("L2")
Do Until Runcount = 1000
    Range("C13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C14").Select
    
Application.Calculation = xlCalculationManual
    Mark = Range("H2")
    Tony = Range("H3")
    
    Score = Mark & Dash & Tony
    
    For Each Line In Range(Cells(5, "G"), Cells(5, "G").End(xlDown))
        ScoreSet = Cells(Line.Row, 7)
        If Score = ScoreSet Then
            ScorePlus = Cells(Line.Row, 8)
            ScorePlus = ScorePlus + 1
            Cells(Line.Row, 8).Value = ScorePlus
        Else
        End If
    Next
    
Application.Calculation = xlCalculationAutomatic
    Runcount = Runcount + 1
    Range("L2").Value = Runcount
Loop
Application.ScreenUpdating = True

End Sub

This is how I have the layout of the sheet for this macro to run right....


[TABLE="class: grid, width: 347, align: center"]
<TBODY>[TR]
[TD]Player Name (A1)</SPAN>[/TD]
[TD]Score</SPAN>[/TD]
[TD]RAND</SPAN>[/TD]
[TD]Point</SPAN>[/TD]
[/TR]
[TR]
[TD]Mark</SPAN>[/TD]
[TD]0.5</SPAN>[/TD]
[TD]0.508658441</SPAN>[/TD]
[TD]0</SPAN>[/TD]
[/TR]
[TR]
[TD]Tony</SPAN>[/TD]
[TD]0.254</SPAN>[/TD]
[TD]0.968425994</SPAN>[/TD]
[TD]0</SPAN>[/TD]
[/TR]
[TR]
[TD]Mark</SPAN>[/TD]
[TD]0.369</SPAN>[/TD]
[TD]0.413288778</SPAN>[/TD]
[TD]0</SPAN>[/TD]
[/TR]
[TR]
[TD]Mark</SPAN>[/TD]
[TD]0.471</SPAN>[/TD]
[TD]0.806637426</SPAN>[/TD]
[TD]0</SPAN>[/TD]
[/TR]
[TR]
[TD]Tony</SPAN>[/TD]
[TD]0.21</SPAN>[/TD]
[TD]0.814040217</SPAN>[/TD]
[TD]0</SPAN>[/TD]
[/TR]
[TR]
[TD]Mark</SPAN>[/TD]
[TD]0.15</SPAN>[/TD]
[TD]0.068789169</SPAN>[/TD]
[TD]1</SPAN>[/TD]
[/TR]
[TR]
[TD]Tony</SPAN>[/TD]
[TD]0.369</SPAN>[/TD]
[TD]0.986007417</SPAN>[/TD]
[TD]0</SPAN>[/TD]
[/TR]
[TR]
[TD]Tony</SPAN>[/TD]
[TD]0.471</SPAN>[/TD]
[TD]0.827633459</SPAN>[/TD]
[TD]0 (D10)[/TD]
[/TR]
</TBODY>[/TABLE]



Cells in blue are those you identified would be manually updated. Points of placement A1 & D10 in red for accuracy.

Offset to the right I have placed an anchor for Mark & Tony totals, using the folloing format and formula offset in green.

[TABLE="class: grid, width: 500"]
<TBODY>[TR]
[TD]Name (G)[/TD]
[TD]Total (H)[/TD]
[TD]Formula in H cells[/TD]
[/TR]
[TR]
[TD]Mark (G2)[/TD]
[TD]1 (H2)[/TD]
[TD]=SUMIF($A$2:$A$9,"Mark",$D$2:$D$9)[/TD]
[/TR]
[TR]
[TD]Tony (G3)[/TD]
[TD]0 (H3)[/TD]
[TD]=SUMIF($A$2:$A$9,"Tony",$D$2:$D$9)[/TD]
[/TR]
</TBODY>[/TABLE]

Further offset, I have a counter for the number of runs completed.

[TABLE="class: grid, width: 500"]
<TBODY>[TR]
[TD]Title (K)[/TD]
[TD]Count of Runs (L)[/TD]
[/TR]
[TR]
[TD]Total Runs (K2)[/TD]
[TD]X (L2)[/TD]
[/TR]
</TBODY>[/TABLE]


Beneath all this, I have your table for potential outcomes, I expanded the list to the full list of potential outcomes.



[TABLE="class: grid, width: 671, align: right"]
<TBODY>[TR]
[TD]Potential Outcome</SPAN>[/TD]
[TD]Point for Succes in outcome</SPAN>[/TD]
[TD]Outcome %</SPAN>[/TD]
[TD]Formula for % Column</SPAN>[/TD]
[/TR]
[TR]
[TD]0-0 (G5)</SPAN>[/TD]
[TD]35</SPAN>[/TD]
[TD]4.28%</SPAN>[/TD]
[TD]=IF(H5=0,"",H5/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]0-1</SPAN>[/TD]
[TD]54</SPAN>[/TD]
[TD]6.60%</SPAN>[/TD]
[TD]=IF(H6=0,"",H6/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]0-2</SPAN>[/TD]
[TD]45</SPAN>[/TD]
[TD]5.50%</SPAN>[/TD]
[TD]=IF(H7=0,"",H7/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]0-3</SPAN>[/TD]
[TD]14</SPAN>[/TD]
[TD]1.71%</SPAN>[/TD]
[TD]=IF(H8=0,"",H8/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]0-4</SPAN>[/TD]
[TD]1</SPAN>[/TD]
[TD]0.12%</SPAN>[/TD]
[TD]=IF(H9=0,"",H9/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]1-0</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]=IF(H10=0,"",H10/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]1-1</SPAN>[/TD]
[TD]176</SPAN>[/TD]
[TD]21.52%</SPAN>[/TD]
[TD]=IF(H11=0,"",H11/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]1-2</SPAN>[/TD]
[TD]120</SPAN>[/TD]
[TD]14.67%</SPAN>[/TD]
[TD]=IF(H12=0,"",H12/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]1-3</SPAN>[/TD]
[TD]30</SPAN>[/TD]
[TD]3.67%</SPAN>[/TD]
[TD]=IF(H13=0,"",H13/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]1-4</SPAN>[/TD]
[TD]4</SPAN>[/TD]
[TD]0.49%</SPAN>[/TD]
[TD]=IF(H14=0,"",H14/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]2-0</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]=IF(H15=0,"",H15/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]2-1</SPAN>[/TD]
[TD]112</SPAN>[/TD]
[TD]13.69%</SPAN>[/TD]
[TD]=IF(H16=0,"",H16/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]2-2</SPAN>[/TD]
[TD]97</SPAN>[/TD]
[TD]11.86%</SPAN>[/TD]
[TD]=IF(H17=0,"",H17/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]2-3</SPAN>[/TD]
[TD]33</SPAN>[/TD]
[TD]4.03%</SPAN>[/TD]
[TD]=IF(H18=0,"",H18/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]2-4</SPAN>[/TD]
[TD]2</SPAN>[/TD]
[TD]0.24%</SPAN>[/TD]
[TD]=IF(H19=0,"",H19/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]3-0</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]=IF(H20=0,"",H20/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]3-1</SPAN>[/TD]
[TD]53</SPAN>[/TD]
[TD]6.48%</SPAN>[/TD]
[TD]=IF(H21=0,"",H21/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]3-2</SPAN>[/TD]
[TD]29</SPAN>[/TD]
[TD]3.55%</SPAN>[/TD]
[TD]=IF(H22=0,"",H22/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]3-3</SPAN>[/TD]
[TD]13</SPAN>[/TD]
[TD]1.59%</SPAN>[/TD]
[TD]=IF(H23=0,"",H23/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]3-4</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]=IF(H24=0,"",H24/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]4-0</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD]=IF(H25=0,"",H25/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]4-1</SPAN>[/TD]
[TD]3</SPAN>[/TD]
[TD]0.37%</SPAN>[/TD]
[TD]=IF(H26=0,"",H26/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]4-2</SPAN>[/TD]
[TD]6</SPAN>[/TD]
[TD]0.73%</SPAN>[/TD]
[TD]=IF(H27=0,"",H27/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]4-3</SPAN>[/TD]
[TD]2</SPAN>[/TD]
[TD]0.24%</SPAN>[/TD]
[TD]=IF(H28=0,"",H28/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
[TR]
[TD]4-4</SPAN>[/TD]
[TD][/TD]
[TD](I29)[/TD]
[TD]=IF(H29=0,"",H29/SUM($H$5:$H$25))</SPAN>[/TD]
[/TR]
</TBODY><COLGROUP><COL><COL><COL><COL></COLGROUP>[/TABLE]
 
Upvote 0
A modification to the code, previously was generating a few more runs before addressing the 1000 count was met, and full range to clear was not provided initially.

Code: 
Private Sub CommandButton1_Click()
'This macro will run 1000 scripts and provide statistics as requested
'Cell L2 has been set as the Run Total for counting measures
'H2 captures Marks total score
'H3 captures Tonys total score
Dim Runcount As Integer
Dim Mark As Integer
Dim Tony As Integer
Dim Score As String
Dim ScoreSet As String
Dim ScorePlus As Integer
Dim Dash As String
Application.ScreenUpdating = False
Dash = (Chr(45))

Range("H5:H29").Select
Selection.ClearContents
Do Until Runcount = 1000
    Runcount = Range("L2")
    Range("C13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C14").Select
    
Application.Calculation = xlCalculationManual
    Mark = Range("H2")
    Tony = Range("H3")
    
    Score = Mark & Dash & Tony
    
    For Each Line In Range(Cells(5, "G"), Cells(5, "G").End(xlDown))
        ScoreSet = Cells(Line.Row, 7)
        If Score = ScoreSet Then
            ScorePlus = Cells(Line.Row, 8)
            ScorePlus = ScorePlus + 1
            Cells(Line.Row, 8).Value = ScorePlus
        Else
        End If
    Next
    
Application.Calculation = xlCalculationAutomatic
    Runcount = Range("L2")
Loop
Application.ScreenUpdating = True
End Sub

Adjust the Total Runs cell L2 to hold this formula: =SUM(H5:H29)
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Skins Game Conditional Formatting
2
Replies
16
Views
2K
Peter_SSs
Peter_SSs
F
  • Question Question
Scoresheet creation for a trivia game
Replies
1
Views
326
Rijnsent
Rijnsent
E
  • Question Question
Pulling together data from multiple MS Forms spreadsheets and displaying into a single league table
Replies
6
Views
286
excelnewbie999
E
M
  • Question Question
Macro or Power Automate to Identify and Move "Washes" from the "Master" Sheet to the "Washes" Sheet
Replies
0
Views
172
Madam_Xavier
M
G
  • Question Question
Embedded Range or Array Lookup
Replies
5
Views
480
Fluff
Fluff

Forum statistics

Threads
1,223,248
Messages
6,171,027
Members
452,374
Latest member
keccles

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