Hello all,
i just got the the following VBA from ExtendOffice - Best Office Productivity Tools
The code works almost like what i was looking for...
I would love to have your assistance on 1 thing if possible....
for the result to be randomized
at this moment the code is only separating the list in groups but on the same orderfrom the list
Many thanks
i just got the the following VBA from ExtendOffice - Best Office Productivity Tools
The code works almost like what i was looking for...
I would love to have your assistance on 1 thing if possible....
for the result to be randomized
at this moment the code is only separating the list in groups but on the same orderfrom the list
Many thanks
VBA Code:
Sub SplitIntoCellsPerColumn()
'updateby Extendoffice
Dim xRg As Range
Dim xOutRg As Range
Dim xCell As Range
Dim xTxt As String
Dim xOutArr As Variant
Dim I As Long, K As Long
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Sel:
Set xRg = Nothing
Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Areas.Count > 1 Then
MsgBox "does not support multiple selections, please select again", vbInformation, "Kutools for Excel"
GoTo Sel
End If
If xRg.Columns.Count > 1 Then
MsgBox "does not support multiple columns,please select again", vbInformation, "Kutools for Excel"
GoTo Sel
End If
Set xOutRg = Application.InputBox("please select a cell to put the result:", "Kutools for Excel", , , , , , 8)
If xOutRg Is Nothing Then Exit Sub
I = Application.InputBox("the number of cell per column:", "Kutools for Excel", , , , , , 1)
If I < 1 Then
MsgBox "incorrect enter", vbInformation, "Kutools for Excel"
Exit Sub
End If
ReDim xOutArr(1 To I, 1 To Int(xRg.Rows.Count / I) + 1)
For K = 0 To xRg.Rows.Count - 1
xOutArr(1 + (K Mod I), 1 + Int(K / I)) = xRg.Cells(K + 1)
Next
xOutRg.Range("A1").Resize(I, UBound(xOutArr, 2)) = xOutArr
End Sub