L
L. Howard
This first code works excellent.
The code below it is my attempt to modify that working code to produce six 'blocks' one below the next, with the random sorted numbers incremented by 20 for each column to continue on to the last block.
Starts at 1 - 21 in first block first column so the last column in the sixth block would be 221 - 276. (hope I got the math correct)
The six lines that are commented out in the second code are the rows and MyCol is the column the subsequent blocks should be in.
I am trying to increment rowUp and rowDn for the WorksheetFunction.Transpose(b)
output. As it is the output is strange and I cannot figure how or where to make my adjustments.
Thanks,
Howard
Sub Randomizer_Description_6x20()
'/ by Claus
Dim a(19) As Variant, b, c, d, e, f
Dim Small As Integer, Big As Integer
Dim i As Long, j As Long, myCol As Long
Dim mC As Long
' Must Name the Sheet and Range for Cleaing Randomized Results.
'Sheets("Description Builder").Range("A2:A127").ClearContents
Application.ScreenUpdating = False
'1 to 6 = Number of Times to run Randomizer
For mC = 1 To 6
Small = 1
Big = 20
' 3 to 13 step 2 = Column 3 or C, Column 13 or M.
For myCol = 3 To 13 Step 2
j = 0
For i = Small To Big
a(j) = i
j = j + 1
Next
b = a: Randomize
d = UBound(b)
For c = 0 To d
e = Int(d * Rnd) + 1
f = b(c): b(c) = b(e): b(e) = f
Next
Range(Cells(2, myCol), Cells(21, myCol)) = _
WorksheetFunction.Transpose(b)
Small = Small + 20
Big = Big + 20
Next
' This is the range of the concatenated results / Sheet must be named here.
' The "B" assigns the column for special paste
' The (2) allows no blank rows between the pastespecial.
'Range("P221").Copy
'Sheets("Description Builder").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
Next 'mC
Application.CutCopyMode = True
Application.ScreenUpdating = True
Beep
End Sub
Sub Exp_Randomizer_Description_6x20()
'/ by Claus (modified)
Dim a(19) As Variant, b, c, d, e, f
Dim Small As Integer, Big As Integer
Dim i As Long, j As Long, myCol As Long
Dim mC As Long
Dim rowUp As Long, rowDn As Long
' Must Name the Sheet and Range for Cleaing Randomized Results.
'Sheets("Sheet1").Range("A2:A127").ClearContents
Application.ScreenUpdating = False
'1 to 6 = Number of Times to run Randomizer
For mC = 1 To 36
Range("A1") = Range("A1") + 1
' Small = The first cell ( 1 ) Big = The last cell ( 20 ) of the Title Data.
Small = 1
Big = 20
rowUp = 2
rowDn = 21
' 3 to 13 step 2 = Column 3 or C, Column 13 or O.
For myCol = 3 To 13 Step 2
j = 0
For i = Small To Big
a(j) = i
j = j + 1
Next
b = a: Randomize
d = UBound(b)
For c = 0 To d
e = Int(d * Rnd) + 1
f = b(c): b(c) = b(e): b(e) = f
Next
Range(Cells(rowUp, myCol), Cells(rowDn, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(2, myCol), Cells(21, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(24, myCol), Cells(43, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(46, myCol), Cells(65, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(68, myCol), Cells(87, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(90, myCol), Cells(109, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(112, myCol), Cells(131, myCol)) = _
WorksheetFunction.Transpose(b)
Small = Small + 20
Big = Big + 20
rowUp = rowUp + 22
rowDn = rowDn + 22
Next
' This is the range of the concatenated results / Sheet must be named here.
' The "B" assigns the column for special paste
' The (2) allows no blank rows between the pastespecial.
' Range("P221").Copy
'Sheets("Description Builder").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
Next 'mC
Application.CutCopyMode = True
Application.ScreenUpdating = True
Beep
End Sub
The code below it is my attempt to modify that working code to produce six 'blocks' one below the next, with the random sorted numbers incremented by 20 for each column to continue on to the last block.
Starts at 1 - 21 in first block first column so the last column in the sixth block would be 221 - 276. (hope I got the math correct)
The six lines that are commented out in the second code are the rows and MyCol is the column the subsequent blocks should be in.
I am trying to increment rowUp and rowDn for the WorksheetFunction.Transpose(b)
output. As it is the output is strange and I cannot figure how or where to make my adjustments.
Thanks,
Howard
Sub Randomizer_Description_6x20()
'/ by Claus
Dim a(19) As Variant, b, c, d, e, f
Dim Small As Integer, Big As Integer
Dim i As Long, j As Long, myCol As Long
Dim mC As Long
' Must Name the Sheet and Range for Cleaing Randomized Results.
'Sheets("Description Builder").Range("A2:A127").ClearContents
Application.ScreenUpdating = False
'1 to 6 = Number of Times to run Randomizer
For mC = 1 To 6
Small = 1
Big = 20
' 3 to 13 step 2 = Column 3 or C, Column 13 or M.
For myCol = 3 To 13 Step 2
j = 0
For i = Small To Big
a(j) = i
j = j + 1
Next
b = a: Randomize
d = UBound(b)
For c = 0 To d
e = Int(d * Rnd) + 1
f = b(c): b(c) = b(e): b(e) = f
Next
Range(Cells(2, myCol), Cells(21, myCol)) = _
WorksheetFunction.Transpose(b)
Small = Small + 20
Big = Big + 20
Next
' This is the range of the concatenated results / Sheet must be named here.
' The "B" assigns the column for special paste
' The (2) allows no blank rows between the pastespecial.
'Range("P221").Copy
'Sheets("Description Builder").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
Next 'mC
Application.CutCopyMode = True
Application.ScreenUpdating = True
Beep
End Sub
Sub Exp_Randomizer_Description_6x20()
'/ by Claus (modified)
Dim a(19) As Variant, b, c, d, e, f
Dim Small As Integer, Big As Integer
Dim i As Long, j As Long, myCol As Long
Dim mC As Long
Dim rowUp As Long, rowDn As Long
' Must Name the Sheet and Range for Cleaing Randomized Results.
'Sheets("Sheet1").Range("A2:A127").ClearContents
Application.ScreenUpdating = False
'1 to 6 = Number of Times to run Randomizer
For mC = 1 To 36
Range("A1") = Range("A1") + 1
' Small = The first cell ( 1 ) Big = The last cell ( 20 ) of the Title Data.
Small = 1
Big = 20
rowUp = 2
rowDn = 21
' 3 to 13 step 2 = Column 3 or C, Column 13 or O.
For myCol = 3 To 13 Step 2
j = 0
For i = Small To Big
a(j) = i
j = j + 1
Next
b = a: Randomize
d = UBound(b)
For c = 0 To d
e = Int(d * Rnd) + 1
f = b(c): b(c) = b(e): b(e) = f
Next
Range(Cells(rowUp, myCol), Cells(rowDn, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(2, myCol), Cells(21, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(24, myCol), Cells(43, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(46, myCol), Cells(65, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(68, myCol), Cells(87, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(90, myCol), Cells(109, myCol)) = _
WorksheetFunction.Transpose(b)
'Range(Cells(112, myCol), Cells(131, myCol)) = _
WorksheetFunction.Transpose(b)
Small = Small + 20
Big = Big + 20
rowUp = rowUp + 22
rowDn = rowDn + 22
Next
' This is the range of the concatenated results / Sheet must be named here.
' The "B" assigns the column for special paste
' The (2) allows no blank rows between the pastespecial.
' Range("P221").Copy
'Sheets("Description Builder").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
Next 'mC
Application.CutCopyMode = True
Application.ScreenUpdating = True
Beep
End Sub