All posible sequences of 10 playes - URGENT

Hi Experts,
This is probably realy easy but its monday and my heads not working. Here is what i need to achieve;

There are 10 player and they need to play eash other twice in a game of pool hoe can i do a program which randomly selects the payers and makes sure each player has played everyone else?
This needs to be done in VB6 or and Excel spreadsheet.

Regards,

Munzi
munzi79Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RogueSolutionsCommented:
Maybe I am missing something but if everyone has to play everyone else twice what do you need random selection for?

With Excel just draw a grid with Players across top and down the sides.  Knock out the diagonal (player one versus player one, etc.).  Whenever a pair play you tick the relevant crossovers for each.  Two ticks in every square and you're done.

Are you looking to create a play order for the matches randomly (assuming youmonly have one pool table)?


0
munzi79Author Commented:
Sorry RogueSolutions,

Yes, i am looking to create a play order for the matches randomly and yes there is only one pool table.
0
jimbobmcgeeCommented:
This better not be a school assignment, or I'm in trouble... ;)

    Public Players(1 To 10) As String
    Public Matches(1 To 90)
   
     
    Sub Main()
   
        Call PopulatePlayers
        Call GenerateMatches
        Call OutputMatches("C:\UnshuffledMatches.txt")
        Call ShuffleMatches
        Call OutputMatches("C:\ShuffledMatches.txt")
   
    End Sub
   
   
    Sub PopulatePlayers()
       
            Players(1) = "Andy"
            Players(2) = "Brian"
            Players(3) = "Claire"
            Players(4) = "Derek"
            Players(5) = "Edward"
            Players(6) = "Fred"
            Players(7) = "Gerry"
            Players(8) = "Hannah"
            Players(9) = "Isabel"
            Players(10) = "Jim"
       
    End Sub
   
    Sub GenerateMatches()
   
        Match = 0
       
        For Player1 = 1 To 10               'LOOP THROUGH PLAYERS
       
            For Player2 = 1 To 10           'LOOP THROUGH PLAYERS
           
                Match = Match + 1           'INCREMENT MATCHES
           
                If Player2 = Player1 Then Player2 = Player2 + 1
                                            'PLAYER CANNOT PLAY HIMSELF
                If Player2 > 10 Then Exit For
                                            'NOT MORE THAN TEN PLAYERS
               
                Matches(Match) = Players(Player1) & " v " & Players(Player2)
                                            'ADD MATCH TO ARRAY
               
            Next Player2
           
        Next Player1
   
    End Sub
   
   
    Sub ShuffleMatches()
   
        For Shuffles = 1 To 10
               
            For Counter = 1 To 90
           
                Randomize Timer
               
                tempStr = Matches(Counter)
                tempInt = Int(Rnd * 90) + 1
               
                Matches(Counter) = Matches(tempInt)
                Matches(tempInt) = tempStr  'SHUFFLE MATCHES
           
            Next Counter
           
        Next Shuffles
   
    End Sub
   
   
    Sub OutputMatches(FileName As String)
   
        Open FileName For Output As #1
       
            For Counter = 1 To 90
           
                Print #1, Matches(Counter)
               
            Next Counter
           
        Close #1
       
    End Sub

HTH

J
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

munzi79Author Commented:
Thanks great J,
But i need the to schedule the results in fixtures i.e
 Fixture 1
player 1 vs player 2
player3 vs player 4
player 5 vs player 6
player 7 vs player 8
player 9 vs player 10

Fixture 2
player 1 vs player 3
player 2 vs player 4
player 5 vs player 7
player 6 vs player 10
player 9 vs player 8

fixture 3
etc......

Regars,

Munzi
0
jimbobmcgeeCommented:
The quickest way is to say each fixture consists of 5 random matches, changing OutputMatches as follows:

    Sub OutputMatches(FileName As String)

        Fixture = 0
   
        Open FileName For Output As #1
       
            For Counter = 1 To 90
           
                  If (Counter - 1) / 5 = (Counter - 1) \ 5 Then
                       Fixture = Fixture + 1
                       Print #1, vbCrLf & "Fixture " & Fixture
                  End If

                  Print #1, Matches(Counter)
               
            Next Counter
           
        Close #1
       
    End Sub

But if everyone has to play on every day, you'll need something more complicated...

J.
0
munzi79Author Commented:
Thans J,

But unfortunatly i need everyone to play on the same day, my appologies for not making this clear earlier.

Regards,

Munzi
0
jimbobmcgeeCommented:
Then I don't think random matches are your best solution.  Will try to generate a formula...

J.
0
munzi79Author Commented:
Thans J.....
look forward to your answer.
0
RogueSolutionsCommented:

Is this a real life thing?  

It's just you have 90 matches to get played on one pool table in one day?  

Average game of pool - 10mins maybe longer?

900mins of pool = 15 hours pool!

Still an interesting problem ;)


0
munzi79Author Commented:
ummm thats what i thought when i got told this first ;o)
Yes, its a real life situation,

there is going to be 1 fixture per day and everyone must play in each fixture.....
0
fds_fatboyCommented:
Try this:
Create a new project. Place a list box and a command button: List1 and Command1 respectively. Place the following code in it. Run it and press the button. The code should work with any number of players but I am not certain about the fixture headers if an odd number of players was selected.

The initial array building could be made more efficient - I get 90 matches, then jettison half of them and then double the 45 matches, reversing the latter 45's homes and aways.



Option Explicit
Private Players() As String
Private PlayerNames As String

Private Sub Command1_Click()
    Players = Split(PlayerNames, ",")
    ShufflePlayers
    Play
End Sub

Private Sub Form_Load()
    Randomize (Timer)
    PlayerNames = "Alice,Bob,Charlie,Dave,Eddie,Freda,George,Harry,Ian,Jack"
End Sub

Private Sub ShufflePlayers()
    Dim lPlayers() As String
    Dim i As Long
    Dim j As Long
    Dim r As Long
   
    ReDim lPlayers(UBound(Players))
   
    For i = 0 To UBound(Players)
        r = Fix(Rnd * UBound(Players))
        Do Until lPlayers(r) = vbNullString
            r = IIf(r < UBound(Players), r + 1, 0)
        Loop
        lPlayers(r) = Players(i)
    Next
   
    Players = lPlayers
End Sub

Private Sub Play()
    Dim i As Long
    Dim j As Long
    Dim u As Long
    Dim p As Long
    Dim m1() As Long
    Dim m2() As Long
    Dim t As Long
    Dim c As Long
    Dim c2 As Long
    Dim f As Long

    List1.Clear

    u = UBound(Players)
    p = u + 1
   
    ReDim m1(p ^ 2 - (p + 1), 1)
   
    For i = 1 To p
        For j = 0 To u
            t = IIf(j + i < p, j + i, j + i - p)
            If j <> t Then
                m1(c, 0) = j
                m1(c, 1) = t
                c = c + 1
               
            End If
        Next
    Next

    c = p \ 2

    For i = 0 To 1
        For j = 0 To UBound(m1, 1) Step 2
            c = c + 1
            If c >= p \ 2 Then
                f = f + 1
                List1.AddItem "Fixture " & f
                c = 0
            End If
            If f And 1 Then
                List1.AddItem "     " & Players(m1(j, 0)) & "  v  " & Players(m1(j, 1))
            Else
                List1.AddItem "     " & Players(m1(j, 1)) & "  v  " & Players(m1(j, 0))
            End If
        Next
    Next
       
End Sub
0
fds_fatboyCommented:
You don't need c2 or m2 variables in it - delete them. I accidentally left them there when I tried something else.
0
jimbobmcgeeCommented:
Nope, no joy; I don't have my math hat on today...
0
fds_fatboyCommented:
Well I've just tested my solution. It keels over (expectedly) if you give it one name or no names.Otherwise it appears to work for any number of names at least up to 40 (158 fixtures of 20 matches each). If you give it an odd number, one person sits out each of the fixtures.
0
fds_fatboyCommented:
Well I tested it again. I was wrong - how embarassing. It's close but not quite. I'll have to work out that first bit properly.
0
munzi79Author Commented:
fds_fatboy,

Thanks for trying...i have tested it wih four players and it does not seem to work, as you have alreay mentioned....any ideas?

J.....have you got your maths hat on today?

Regards,

Munzi
0
jimbobmcgeeCommented:
No, I can get it so far, using bitwise logic and it will generate 90 matches, where everyone plays everyone twice but I can't get it to do it so that everyone plays on the same day.

J.
0
RogueSolutionsCommented:
I tried a brute force approach and I think it 'should' work.  Basically it will create a random Fixture of 5 matches but then reject it if anyone has played before.  Since you want two matches per 'couple' the theory works OK since P1 vs P2 is one match and P2 vs P1 is the other.

Unfortunately I doubt it could ever solve it fully since the probability keeps getting harder!

Am trying to think how to cross breed this approach with an ordered selection but ...

Start a blank Excel workbook, add a module and paste the code.  It will work with the activesheet (and it will blank it!)

The progress (fixtures found) is shown on the statusbar

Public Sub Matches()

    Dim iL      As Integer
    Dim iR1     As Integer
    Dim iR2     As Integer
    Dim bP(10)  As Boolean
    Dim iRow    As Integer
    Dim iBack   As Integer
    Dim bSame   As Boolean
   
    Application.ScreenUpdating = False
   
    ActiveSheet.Cells.ClearContents
   
    iRow = 1
    While iRow <= 90
   
        For iL = 1 To 5
       
            iR1 = Int(10 * Rnd + 1)
            While bP(iR1)
                iR1 = Int(10 * Rnd + 1)
            Wend
            bP(iR1) = True
           
            iR2 = Int(10 * Rnd + 1)
            While bP(iR2) Or iR1 = iR2
                iR2 = Int(10 * Rnd + 1)
            Wend
            bP(iR2) = True
   
            ActiveSheet.Cells(iRow, iL).Value = iR1 & " vs " & iR2
           
        Next
       
        With ActiveSheet.Range(ActiveSheet.Cells(iRow, 1), ActiveSheet.Cells(iRow, 2))
                 
            If iRow > 1 Then
           
                For iBack = iRow - 1 To 1 Step -1
                    bSame = False
                    For iL = 1 To 5
                        If Application.WorksheetFunction.CountIf(ActiveSheet.Range("A1:E100"), ActiveSheet.Cells(iRow, iL).Value) > 1 Then
                            bSame = True
                            Exit For
                        End If
                    Next
                    If bSame Then
                        .ClearContents
                        iRow = iRow - 1
                        Exit For
                    End If
                Next
           
            End If
           
        End With
       
        For iL = 1 To 10
            bP(iL) = False
        Next
               
        iRow = iRow + 1
        Application.StatusBar = iRow
       
    Wend
   
    Application.ScreenUpdating = True
   
End Sub

0
jimbobmcgeeCommented:
I've got a brute-force method that definately works; it just keeps generating files until it gets it right (usually in less than 500 attempts -- its quite quick really)

It's based on the bitwise thing I was trying earlier.  The problem I was having was that the logic was able to make sure that a player did not have two matches in the same fixture, but it couldn't force it to create fixtures where everybody played.  

It's all to do with the order in which the match list is passed to the sorting function; only certain orders work.  So I created a brute force system, with a randomizer, that just keeps going until it hits a suitable sequence.

It should work for any array of players, even or odd, but gets a bit slow around the 20-mark.  You might have to start it off, go away and come back, as the more players used, the longer it will take.  

Here goes:

    Public Type FixtureType
        Name        As String
        Value       As Long
        DeleteMe    As Boolean
    End Type
   
    Public Players()        As FixtureType
    Public Matches()        As FixtureType
    Public SavedMatches()   As FixtureType
   
    Public Everyone         As Long
    Public DebugCount       As Long
    Public TargetFixtures   As Long
    Public ActualFixtures   As Long
   
    Private Sub GetPlayerNames()
       
        ReDim Players(1 To 10) As FixtureType   'NOTE: MANUALLY SET UP PLAYER ARRAY
                                                '      WITH THE RIGHT SIZE!!
        Players(1).Name = "Andy"
        Players(2).Name = "Brian"
        Players(3).Name = "Claire"
        Players(4).Name = "Derek"
        Players(5).Name = "Edward"
        Players(6).Name = "Fred"
        Players(7).Name = "Gerry"
        Players(8).Name = "Hannah"
        Players(9).Name = "Isabel"
        Players(10).Name = "Jim"
           
    End Sub
   
   
    Private Sub AssignPlayerValues()
   
        'CREATE BITWISE VALUES FOR EACH PLAYER
        '   E.G.    1000000000 FOR PLAYER 1 = &H200 = 512
        '           0000000001 FOR PLAYER 2 = &H100 = 256
        '           0100000000 FOR PLAYER 3 = &H80  = 128
        '           0000000010 FOR PLAYER 4 = &H40  = 64
        '           ETC
       
        Everyone = 0
         
        For i = LBound(Players()) To UBound(Players())
       
            Players(i).Value = 2 ^ (((UBound(Players()) + 1) - i) - 1)
            Everyone = Everyone + Players(i).Value
           
        Next i
   
    End Sub
   
   
    Private Sub GenerateMatches()
       
        'USE LOGICAL OR TO CREATE A NUMBER FOR EACH MATCH, BASED ON THE
        'VALUES FOR EACH PLAYER PLAYING
        '   E.G.    PLAYER 1 v PLAYER 2 = 1100000000 = &H300 = 768
        '           PLAYER 3 v PLAYER 4 = 0011000000 = &HC0  = 192
        '           PLAYER 2 v PLAYER 1 = 1100000000 = &H300 = 768
       
        Dim MatchCount As Long
       
        MatchCount = 0
        For Plr1 = LBound(Players()) To UBound(Players())
            For Plr2 = LBound(Players()) To UBound(Players())
                If Plr2 = Plr1 Then Plr2 = Plr2 + 1
                If Plr2 > UBound(Players()) Then Exit For
                MatchCount = MatchCount + 1
            Next Plr2
        Next Plr1
       
        ReDim SavedMatches(1 To MatchCount) As FixtureType
       
        MatchCount = 0
        For Plr1 = LBound(Players()) To UBound(Players())
            For Plr2 = LBound(Players()) To UBound(Players())
           
                If Plr2 = Plr1 Then Plr2 = Plr2 + 1
                If Plr2 > UBound(Players()) Then Exit For
                MatchCount = MatchCount + 1
               
                SavedMatches(MatchCount).Name = Players(Plr1).Name & " v " & Players(Plr2).Name
                SavedMatches(MatchCount).Value = Players(Plr1).Value Or Players(Plr2).Value
                SavedMatches(MatchCount).DeleteMe = False
               
            Next Plr2
        Next Plr1
       
        TargetFixtures = (UBound(SavedMatches()) / (UBound(Players()) / 2)) + _
                (2 * Abs(CInt(Not (UBound(Players()) \ 2) = (UBound(Players()) / 2))))
       
    End Sub
   
   
    Private Sub ShuffleMatches()
   
        'RANDOMIZER AND SHUFFLER, FOR BRUTE FORCE METHOD
   
        Dim tmpMatch As FixtureType
               
            For Counter = 1 To UBound(Matches())
           
                Randomize Timer
               
                tmpMatch.Name = Matches(Counter).Name
                tmpMatch.Value = Matches(Counter).Value
                tmpMatch.DeleteMe = Matches(Counter).DeleteMe
               
                tempInt = Int(Rnd * UBound(Matches())) + 1
               
                Matches(Counter).Name = Matches(tempInt).Name
                Matches(Counter).Value = Matches(tempInt).Value
                Matches(Counter).DeleteMe = Matches(tempInt).DeleteMe
               
                Matches(tempInt).Name = tmpMatch.Name
                Matches(tempInt).Value = tmpMatch.Value
                Matches(tempInt).DeleteMe = tmpMatch.DeleteMe
                                                        'SHUFFLE MATCHES
           
            Next Counter
   
    End Sub
   
   
    Private Sub SortMatches(FileName As String)
   
        'RUN THROUGH MATCHES ASSIGNING TO FIXTURE, OUTPUTTING TO FILENAME
   
        Dim MatchMask   As Long
        Dim Fixtures    As Long
        Dim Count       As Long
       
        ActualFixtures = 1
        Count = 0
   
        Open FileName For Output As #1
           
            Do Until UpdateMatchList = 0
           
                MatchMask = 0
                Print #1, "Fixture " & ActualFixtures
               
                    For i = LBound(Matches()) To UBound(Matches())
                        Matches(i).DeleteMe = False
                    Next i
           
                    For i = LBound(Matches()) To UBound(Matches())
                   
                        If MatchMask = Everyone Then Exit For
                       
                        If (Matches(i).Value And MatchMask) = 0 Then
                       
                            MatchMask = (MatchMask Or Matches(i).Value)
                            Matches(i).DeleteMe = True
   
                            Print #1, Matches(i).Name & vbTab & _
                                      Matches(i).Value & vbTab & _
                                      MatchMask & vbTab;
                                   
                            For z = UBound(Players()) To LBound(Players()) Step -1
                                Print #1, CStr(Abs(CInt((MatchMask And Players(z).Value) <> 0)));
                            Next z
                            Print #1, ""
                           
                            Count = Count + 1
                   
                        End If
                       
                    Next i
               
                ActualFixtures = ActualFixtures + 1
                Print #1, ""
               
            Loop
           
            Print #1, vbCrLf & "Matches: " & Count
           
        Close #1
   
    End Sub
   
   
    Private Function UpdateMatchList() As Long
   
        'REMOVE ASSIGNED MATCHES FROM MATCH LIST, SO THEY CANNOT BE USED AGAIN
       
        Dim tmpMatches() As FixtureType
        Dim MatchCount As Long
        tmpMatches() = Matches()
   
        MatchCount = 0
       
        For i = LBound(tmpMatches()) To UBound(tmpMatches())
            If tmpMatches(i).DeleteMe = False Then MatchCount = MatchCount + 1
        Next i
   
        UpdateMatchList = MatchCount
        If MatchCount = 0 Then Exit Function
           
        ReDim Matches(1 To MatchCount) As FixtureType
       
        MatchCount = 0
        For i = LBound(tmpMatches()) To UBound(tmpMatches())
            If tmpMatches(i).DeleteMe = False Then
                MatchCount = MatchCount + 1
                Matches(MatchCount).Name = tmpMatches(i).Name
                Matches(MatchCount).Value = tmpMatches(i).Value
                Matches(MatchCount).DeleteMe = False
            End If
        Next i
   
        Call ShuffleMatches
   
    End Function
   
   
    Private Sub Main()
       
        Attempts = 0            'RESET ATTEMPTS COUNTER
        ActualFixtures = 0      'RESET FIXTURES COUNT
         
        Call GetPlayerNames
        Call AssignPlayerValues
        Call GenerateMatches
       
        Debug.Print "Target Fixtures: " & TargetFixtures
       
        Do Until ActualFixtures - 1 = TargetFixtures    'BRUTE FORCE LOOP UNTIL SOLVED
           
            Attempts = Attempts + 1
            Debug.Print "Attempt #" & Attempts & ": ";    'SHOW STATUS IN DEBUG WINDOW
            Matches() = SavedMatches()       'COPY MATCH LIST TO WORKING LIST, TO SAVE TIME
            SortMatches "c:\fixattempts\fixtures." & Format(Attempts, "00000") & ".txt"
                                'SAVE ATTEMPT TO FILE, BASED ON CURRENT ATTEMPT NUMBER
            Debug.Print "Fixtures=" & ActualFixtures - 1  'SHOW STATUS IN DEBUG WINDOW
           
        Loop
       
        MsgBox "Generation completed in " & Attempts & " attempts."     'SHOW RESULTS
   
    End Sub

Good luck!!

HTH

J.
0
fds_fatboyCommented:
Yes, but look at this:
Not as efficient as it could be (it could be improved) but not all brute force:
Same scenario as before: Form with a list box and command button. It runs with any number over 1 including odds:

Option Explicit
Dim PlayerNames As String
Dim Players() As String
Dim blnOdd As Boolean

Private Sub Command1_Click()
    Command1.Enabled = False
    ShufflePlayers
    Play
    Command1.Enabled = True
End Sub

Private Sub Form_Load()
    Randomize Timer
    PlayerNames = "Alice,Bob,Charlie,Dave,Eddie,Freda,George,Harry,Ian,Jack"

    Players = Split(PlayerNames, ",")
    If Not UBound(Players) And 1 Then
        Players = Split(PlayerNames & ",", ",")
        blnOdd = True
    End If
End Sub

Private Sub ShufflePlayers()
    Dim lPlayers() As String
    Dim i As Long
    Dim j As Long
    Dim r As Long
    Dim u As Long
   
    u = UBound(Players) + blnOdd

    ReDim lPlayers(UBound(Players))

    For i = 0 To u
        r = Fix(Rnd * u)
        Do Until lPlayers(r) = vbNullString
            r = IIf(r < u, r + 1, 0)
        Loop
        lPlayers(r) = Players(i)
    Next

    Players = lPlayers
End Sub

Private Sub Play()
    Dim i As Long, j As Long, c As Long, t As Long
    Dim u As Long, p As Long
    Dim m() As Long, pm() As Long
    Dim mc As Long
    Dim mf As Long, mb As Boolean, mfs As Long
    Dim m2() As Long

    List1.Clear

    u = UBound(Players)
    p = u + 1

    ReDim m(0 To (p ^ 2 - p) - 1, 2)
    ReDim pm(0 To u)

    For i = 1 To p
        For j = 0 To u Step 2
            t = IIf(j + i < p, j + i, j + i - p)
            If j <> t Then
                m(c, 0) = j
                m(c, 1) = t
                c = c + 1
               
            End If
        Next
        For j = 1 To u Step 2
            t = IIf(j + i < p, j + i, j + i - p)
            If j <> t Then
                m(c, 0) = j
                m(c, 1) = t
                c = c + 1
               
            End If
        Next
    Next

    For i = 0 To 2 * u - 1
        DoEvents
        List1.AddItem "Fixture " & i + 1
        mf = -1

        Do
            DoEvents
            mc = 0
            mb = False

            mfs = mf
            For j = mfs + 1 To UBound(m)
                If mc >= p \ 2 Then
                    Exit For
                End If
                If m(j, 2) = 0 And pm(m(j, 0)) <= i And pm(m(j, 1)) <= i Then
                    If Not mb Then
                        mb = True
                        mf = j
                    End If
                    m(j, 2) = -1
                    mc = mc + 1
                    pm(m(j, 0)) = i + 1
                    pm(m(j, 1)) = i + 1
                End If
            Next

            For j = 0 To mfs
                If mc >= p \ 2 Then
                    Exit For
                End If
                If m(j, 2) = 0 And pm(m(j, 0)) <= i And pm(m(j, 1)) <= i Then
                    If Not mb Then
                        mf = j
                    End If
                    m(j, 2) = -1
                    mc = mc + 1
                    pm(m(j, 0)) = i + 1
                    pm(m(j, 1)) = i + 1
                End If
            Next

            If mc < p \ 2 Then
                For j = 0 To UBound(m, 1)
                    If m(j, 2) = -1 Then
                        m(j, 2) = 0
                        pm(m(j, 0)) = i
                        pm(m(j, 1)) = i
                    End If
                Next
                If mf = UBound(m) Then
                    ShuffleMatches m
                End If
            End If
   
        Loop Until mc >= p \ 2

        If UBound(m, 1) > mc Then
            ReDim m2(UBound(m, 1) - mc, 2)
        Else
            ReDim m2(UBound(m, 1), 2)
        End If

        c = 0
        For j = 0 To UBound(m)
            If m(j, 2) = -1 Then
                If Not (blnOdd And (m(j, 0) = u Or m(j, 1) = u)) Then
                    List1.AddItem "     " & Players(m(j, 0)) & "  v  " & Players(m(j, 1))
                End If
            Else
                m2(c, 0) = m(j, 0)
                m2(c, 1) = m(j, 1)
                m2(c, 2) = 0
                c = c + 1
            End If
        Next
        m = m2
    Next
End Sub

Private Sub ShuffleMatches(ByRef m1() As Long)
    Dim m2() As Long
   
    Dim i As Long
    Dim j As Long
    Dim r As Long
    Dim u As Long
   
    u = UBound(m1, 1)
   
    ReDim m2(u, 2)
   
    For i = 0 To u
        r = Fix(Rnd * u)
        Do Until (m2(r, 0) Or m2(r, 1)) = 0
            r = IIf(r < u, r + 1, 0)
        Loop
        m2(r, 0) = m1(i, 0)
        m2(r, 1) = m1(i, 1)
        m2(r, 2) = m1(i, 2)
    Next
   
    m1 = m2
End Sub
   
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
munzi79Author Commented:
Thanks lads, both solutions work.

Munzi
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.