Put Shuffle usability in a VBA code for Excel

Question

Hello, i have this VBA Code:

Sub CopyData()

Dim Rng As Range

Dim InputRng As Range, OutRng As Range

xTitleId = "Lottery"

Set InputRng = Application.Selection

Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)

Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)

Set OutRng = OutRng.Range("A1")

For Each Rng In InputRng.Rows

    xValue = Rng.Range("A1").Value

    xNum = Rng.Range("B1").Value

    OutRng.Resize(xNum, 1).Value = xValue

    Set OutRng = OutRng.Offset(xNum, 0)

Next

End Sub

Can you please help me, add a Shuffle capability, so when i run it, the end result will have its results shuffle? Ty in advance!

***Post moved by the moderator to the appropriate forum category.***

Answer 1

Sub CopyDataRandom()

  Const xTitleId = "Lottery"

  Dim InputRng As Range, OutRng As Range

  Dim DataIn, DataOut

  Dim a As Long, b As Long, c As Long, d As Long

  'Exit if the user aborts

  On Error GoTo Exitpoint

  Set InputRng = Application.InputBox("Range :", xTitleId, Selection.Address(0, 0), Type:=8)

  Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)

  On Error GoTo 0

  'Read in all values

  DataIn = InputRng.Value

  'More then one value?

  If Not IsArray(DataIn) Then

    'No

    OutRng(1, 1).Value = DataIn

  Else

    'Create space for the output

    ReDim DataOut(1 To UBound(DataIn), 1 To UBound(DataIn, 2))

    'Initialize

    Randomize

    'For each input value

    For a = 1 To UBound(DataIn)

      For b = 1 To UBound(DataIn, 2)

        'Find a random free space

        Do

          c = Rnd * (UBound(DataIn) - 1) + 1

          d = Rnd * (UBound(DataIn, 2) - 1) + 1

        Loop Until IsEmpty(DataOut(c, d))

        'Store

        DataOut(c, d) = DataIn(a, b)

      Next

    Next

    'Write back

    OutRng.Resize(UBound(DataIn), UBound(DataIn, 2)).Value = DataOut

  End If

Exitpoint:

End Sub