Randomize cell arrangement in a given range

|||||||E|||||||

New Member
Joined
Mar 22, 2019
Messages
7
Hi All. Didn't find anything in the search results for this. Apologizes if it has surfaced before.

Building a quiz and need VBA code to randomly re-arrange cells within a given range. Answers to the quiz are one an "Answers" worksheet. Cells A8:O13 are linking to those answers.

Starting point:



VBA code should randomly re-arrange those cells, but maintain the links within those cells:

Random re-arrange:



Any help you can provide would be greatly appreciated. Thanks!
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

Gerald Higgins

Well-known Member
Joined
Mar 26, 2007
Messages
9,115
Hi, welcome to the board.

I think if I were doing this, I would take a slightly different approach.
Moving the formulas around into random new locations can surely be done, but seems difficult to me.

Instead, why not use the OFFSET function, and randomise the column and row offset values within the OFFSET functions ?

You could do this by setting up a table containing all of your column and row values for your output range, then use the RAND() function to assign a rank to each of these values, and then perhaps use a combination of OFFSET and LARGE to select these column and row values in the sequence implied by the RAND() function.
 

|||||||E|||||||

New Member
Joined
Mar 22, 2019
Messages
7
That's exactly what I need MickG! Unfortunately, I tried to implement the code into my worksheet and it didn't mesh well. I'm using module macros with buttons. That code is in the Sheet object, and I can't even see what code the buttons are triggering. It seems to be locked down.

Also, I'm not sure what the yellow and green ranges are doing on Sheet2.

Uploaded my current version to:

https://drop.me/BVzXdb
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841

ADVERTISEMENT

Your code seems to be working Ok without my code.
What do you want to add from my code, perhaps just the Randomizing ??
 

|||||||E|||||||

New Member
Joined
Mar 22, 2019
Messages
7
Correct. Everything is working, except the random rearrangement of the answers on the Quiz worksheet (which should pull from the Key worksheet).

The results of your example was perfect, but I couldn't recreate the code given our different approaches.
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this , I put it in the "Next Country"(Random) code.
Code:
[COLOR="Navy"]Sub[/COLOR] Random()

Application.ScreenUpdating = False

Sheets("Key").Select

[COLOR="Navy"]Dim[/COLOR] RowNum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
RowNum = Range("A" & Rows.Count).End(xlUp).Row

[COLOR="Navy"]Dim[/COLOR] RNG1 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] RNG1 = Range("A2:A" & RowNum)

[COLOR="Navy"]Dim[/COLOR] randomCell1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    randomCell1 = Int(Rnd * RNG1.Cells.Count) + 1

[COLOR="Navy"]With[/COLOR] RNG1.Cells(randomCell1)
    .Select
    Selection.Copy
[COLOR="Navy"]End[/COLOR] With

Sheets("Quiz").Select
    Range("H3").Select
    Selection.PasteSpecial Paste:=xlPasteValues


'[COLOR="Green"][B]#############[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
c = 8
[COLOR="Navy"]With[/COLOR] Sheets("Key")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]With[/COLOR] Sheets("Quiz")
        Ac = Ac + 1
        .Cells(c, Ac) = Dn.Value
            [COLOR="Navy"]If[/COLOR] Ac = 15 [COLOR="Navy"]Then[/COLOR]
                c = c + 1: Ac = 0
            [COLOR="Navy"]End[/COLOR] If
     [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] fd [COLOR="Navy"]As[/COLOR] Boolean

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
       fd = False
       [COLOR="Navy"]Do[/COLOR] Until fd
        Col = Application.RandBetween(1, 15)
        Rw = Application.RandBetween(8, 11)
        [COLOR="Navy"]If[/COLOR] Not Cells(Rw, Col) = vbNullString [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not .exists(Cells(Rw, Col).Address) [COLOR="Navy"]Then[/COLOR]
                .Add (Cells(Rw, Col).Address), Nothing
                     Cells(Rw, Col) = Dn.Value
                    fd = True
            [COLOR="Navy"]End[/COLOR] If
         [COLOR="Navy"]End[/COLOR] If
      [COLOR="Navy"]Loop[/COLOR]
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With

'[COLOR="Green"][B]############[/B][/COLOR]

Application.ScreenUpdating = True

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

Watch MrExcel Video

Forum statistics

Threads
1,109,204
Messages
5,527,410
Members
409,760
Latest member
zeeshansyed

This Week's Hot Topics

Top