Move row data left right.

[motilulla]

Using Excel 2010
Hello,

I got some data filled in range C6:P10, example with 5 rows I wonder if data can move randomly in each row without changing any values.

For example row C6:P6 random move in range see the result after macro in H16:P16 vales are the same but has moved randomly. sum of the row has the same, but the sum of column has changed.

Is this possible, if yes it is, please I need only a VBA solution.

Here is below the example with before and after macro results.

ROW-LEFT-RIGHT.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1
2
3
4			Before Macro
5			R1	R2	R3	R4	R5	R6	R7	R8	R9	R10	R11	R12	R13	R14		Sum
6			2	4	7	1	W	4	T	H	5	7	Q	5	3	1		39
7			7	12	22	YY	X	27	32	40	35	12	QW	H	V	A		187
8			27	32	2Q	5T	5	9	TY	W4	G7	5	7	2	1	10		98
9			1	12	22	35	40	22	32	HH	NT	PQ	D5	G7	TK	5L		164
10			QW	EH	JK	52	5	P4	4H	6K	9N	12	27	33	1	4		134
11		Sum	37	60	51	88	50	62	64	40	40	36	34	40	5	15
12
13
14			After Macro
15			R1	R2	R3	R4	R5	R6	R7	R8	R9	R10	R11	R12	R13	R14		Sum
16			H	W	T	2	5	7	5	1	7	4	3	4	1	Q		39
17			12	V	A	QW	YY	27	12	7	22	40	X	32	H	35		187
18			G7	2	2Q	1	5	10	5	5T	7	27	32	TY	9	W4		98
19			TK	HH	40	D5	22	1	32	5L	PQ	22	35	12	G7	NT		164
20			1	QW	27	9N	JK	33	12	52	P4	EH	6K	5	4	4H		134
21		Sum	13	2	67	3	32	78	66	60	36	93	70	53	14	35
22
23
Sheet1

Cell Formulas
Range	Formula
R16:R20,R6:R10	R6	=SUM(C6:P6)
C21:P21,C11:P11	C11	=SUM(C6:C10)

Regards,
Moti

 

[DanteAmor]

This solution requires using some available cells on your sheet, currently it uses cells "C23:P25", but that may change.

Try:

Sub Move_Data()
  Dim i As Long
  
  For i = 6 To 10
    Range("C23:P23").FormulaR1C1 = "=RAND()"
    Range("C24:P24").FormulaR1C1 = "=RANK.EQ(R[-1]C,R23C3:R23C16)"
    Range("C25:P25").FormulaR1C1 = "=INDEX(R" & i & "C3:R" & i & "C16,0,R[-1]C)"
    
    Range("C" & i & ":P" & i).Value = Range("C25:P25").Value
  Next
  
  Range("C23:P25").ClearContents
End Sub

 

[motilulla]

This solution requires using some available cells on your sheet, currently it uses cells "C23:P25", but that may change.

DanteAmor, yes this worked with simple data I am thankful to you for it.

This has some inconvenient I need to change ranges accordingly data there will always 14 columns and rows can vary 100 to 80000+ could it be some better way regarding formula pure VBA.

Good Luck!

Regards,
Moti

 

[John_w]

Another approach, using arrays.

Public Sub Move_Row_Values()

    Dim rowCells As Range
    Dim rowVals As Variant
    
    Randomize
    For Each rowCells In Range("C6:P10").Rows
        rowVals = rowCells.Value
        RandomArrayVals rowVals
        rowCells.Value = rowVals
    Next
    
End Sub


Private Sub RandomArrayVals(vals As Variant)
    Dim i As Long, r As Long
    Dim swap As Variant
    For i = 1 To UBound(vals, 2)
        r = Rnd * (UBound(vals, 2) - 1) + 1
        swap = vals(1, i): vals(1, i) = vals(1, r): vals(1, r) = swap
    Next
End Sub

 

[DanteAmor]

This has some inconvenient I need to change ranges accordingly data there will always 14 columns and rows can vary 100 to 80000+ could it be some better way regarding formula pure VBA.

Assuming that the last row is the sum, then with the following macro you can have 6, 80000 or whatever, the macro will calculate it automatically.
It will put the entire data set in an array (only one read) and at the end it will put the result (only one write).

Sub Random_Data()
  Dim a As Variant, b As Variant, arr As Variant
  Dim i&, k&, x&, y&, z&
 
  a = Range("C6:P" & Range("C" & Rows.Count).End(3).row - 1).Value   'Input
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  Randomize
  For i = 1 To UBound(a, 1)
    arr = Evaluate("ROW(1:" & UBound(a, 2) & ")")
    k = UBound(arr)
    For z = 1 To k
      x = Int(Rnd * k + z)
      y = arr(z, 1)
      arr(z, 1) = arr(x, 1)
      arr(x, 1) = y
      k = k - 1
      b(i, z) = a(i, arr(z, 1))
    Next
  Next
  Range("C6").Resize(UBound(b, 1), UBound(b, 2)).Value = b  'output
End Sub

 

[motilulla]

Another approach, using arrays.

Public Sub Move_Row_Values()

    Dim rowCells As Range
    Dim rowVals As Variant
   
    Randomize
    For Each rowCells In Range("C6:P10").Rows
        rowVals = rowCells.Value
        RandomArrayVals rowVals
        rowCells.Value = rowVals
    Next
   
End Sub


Private Sub RandomArrayVals(vals As Variant)
    Dim i As Long, r As Long
    Dim swap As Variant
    For i = 1 To UBound(vals, 2)
        r = Rnd * (UBound(vals, 2) - 1) + 1
        swap = vals(1, i): vals(1, i) = vals(1, r): vals(1, r) = swap
    Next
End Sub

John_w, thank you for giving an appropriate solution, I like the method of sorting rows, one by one.

Thank you for your time to help. Have a good day and Good Luck!

Kind Regards,
Moti

 

[motilulla]

Assuming that the last row is the sum, then with the following macro you can have 6, 80000 or whatever, the macro will calculate it automatically.
It will put the entire data set in an array (only one read) and at the end it will put the result (only one write).

Sub Random_Data()
  Dim a As Variant, b As Variant, arr As Variant
  Dim i&, k&, x&, y&, z&
 
  a = Range("C6:P" & Range("C" & Rows.Count).End(3).row - 1).Value   'Input
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  Randomize
  For i = 1 To UBound(a, 1)
    arr = Evaluate("ROW(1:" & UBound(a, 2) & ")")
    k = UBound(arr)
    For z = 1 To k
      x = Int(Rnd * k + z)
      y = arr(z, 1)
      arr(z, 1) = arr(x, 1)
      arr(x, 1) = y
      k = k - 1
      b(i, z) = a(i, arr(z, 1))
    Next
  Next
  Range("C6").Resize(UBound(b, 1), UBound(b, 2)).Value = b  'output
End Sub

DanteAmor, thank you revising and giving a macro solution yes it worked as you described put the result (only one write). And it is fast too.

Thank you for your time to help. Have a good day and Good Luck!

Kind Regards,
Moti

 

[DanteAmor]

DanteAmor, thank you revising and giving a macro solution yes it worked as you described put the result (only one write). And it is fast too.

Thank you for your time to help. Have a good day and Good Luck!

Glad we could help. Thanks and have a good day too.