Alternately mix DATA in MS EXCEL

Question

I have one csv file which contains 10.000 rows. The 2.000 rows have the value "EXPL_1". The 3.000 rows have the value "EXPL_2". The 2.500 rows have the value "EXPL_3". The 1.500 rows have the value "EXPL_4". The 2.000 rows have the value "EXPL_5".

I am searching a function which will mix (re-sort) alternately the values and will continue to mix them until to finish.

So the final result will be something like:

EXPL_1,
EXPL_2,
EXPL_3,
EXPL_4,
EXPL_5,
EXPL_1,
EXPL_2,
EXPL_3,
EXPL_4,
EXPL_5,
.......... (x times repeat)
EXPL_1,
EXPL_2,
EXPL_3,
EXPL_5,    (*EXPL_4 values finished but continue to alternately mix the rest)

*The values are sorted by name (1st all EXPL_1, 2nd all EXPL_2 etc) *Maybe in the future will appear more values. *I know how many values I have in the list.

Based on the numbers you shared with us, you could only generate the 1-2-3-4-5 groupings for 7500 rows, because after that `EXPL_4` data would be exhausted. Would you instead prefer to just have a random shuffle of the 10K rows? — Tim Biegeleisen, Sep 18 '17 at 11:46
The easiest solution which comes in my mind is by seperating the 5 different in array. Than simply loop trough them and add them. In the loop check if the array index is defined if not, simply skip it. — Doomenik, Sep 18 '17 at 11:47
Thank you @TimBiegeleisen for your answer. It's not "fit" to my request the random way. I want exactly with alternately way :( — Bill Trapezanlidis, Sep 18 '17 at 11:50
This would be much easier to handle using VBA or another programming language besides raw Excel. — Tim Biegeleisen, Sep 18 '17 at 11:51
@TimBiegeleisen I am now expert in VBA but I can manage. Do you have something in your mind ? — Bill Trapezanlidis, Sep 18 '17 at 11:54
You could use the `For Loop` [with Step 5](https://stackoverflow.com/questions/19687018/what-does-the-to-and-step-mean-in-vba) to sort ascending each value, it can take some time to proccess. — danieltakeshi, Sep 18 '17 at 12:00
I added a fast and easy way to mix/sort your data. You can use it with or without using vba. Hope this solves your problem. — Jochen, Sep 19 '17 at 15:08

danieltakeshi · Answer 1 · 2017-09-18T14:03:29.703

This code adds "manually" the values to the sheet, based on the quantity of the values. So if there are less values of some type, it will leave blank spaces. I used the cells on the speardsheet, but you can make operations on the array with the same logic, instead of creating a non contiguous range, you can add values to the array index using For loop Step

Dim ws As Worksheet
Dim one_rng As Range
Dim a1(), a2(), i As Long, ub As Long

Set ws = ThisWorkbook.Worksheets(1)
'Insert the number of values
For n = 1 To 5
    If n = 1 Then
    n_array = 20 'insert number of valuer for EXPL_1
    ElseIf n = 2 Then
    n_array = 30 'insert number of valuer for EXPL_2
    ElseIf n = 3 Then
    n_array = 25 'insert number of valuer for EXPL_3
    ElseIf n = 4 Then
    n_array = 15 'insert number of valuer for EXPL_4
    ElseIf n = 5 Then
    n_array = 20 'insert number of valuer for EXPL_5
    End If


    ReDim a1(1 To 1, 1 To n_array) As Variant
    For i = 1 To n_array
     a1(1, i) = CStr("EXPL_" & n)
    Next i
    ub = UBound(a1, 2)
    ReDim a2(1 To ub, 1 To 1) 'resize a2 ("right" shape) to match a1
        ' "flip" the a1 array into a2
        For i = 1 To ub
            a2(i, 1) = a1(1, i)
        Next i

    For i = 5 + n To (5 + n) * (n_array - 1) Step 5
        If i = (5 + n) Then Set one_rng = ws.Range("B" & n)
        Set new_rng = ws.Range("B" & i)
        Set one_rng = Union(one_rng, new_rng)
    Next i
    Debug.Print one_rng.Address 'Verify the Range
    one_rng = a2
Next n

If it is desired to delete the blank spaces, some changes can be done.

You can .Autofilter for blank values on the range used (firstrow to last row) and then delete them.

Sub DeleteBlankRows()
    Range("B:B").Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

And after create an array and add the range to the array.

CODE EXPLANATION

Loop 5 times for the five types of EXPL_

For n = 1 To 5
Next n

Insert number of values to create array for each type

    If n = 1 Then
    n_array = 20 'insert number of valuer for EXPL_1
    ElseIf n = 2 Then
    n_array = 30 'insert number of valuer for EXPL_2
    ElseIf n = 3 Then
    n_array = 25 'insert number of valuer for EXPL_3
    ElseIf n = 4 Then
    n_array = 15 'insert number of valuer for EXPL_4
    ElseIf n = 5 Then
    n_array = 20 'insert number of valuer for EXPL_5
    End If

Create Array

ReDim a1(1 To 1, 1 To n_array) As Variant
For i = 1 To n_array
 a1(1, i) = CStr("EXPL_" & n)
Next i
ub = UBound(a1, 2)
ReDim a2(1 To ub, 1 To 1) 'resize a2 ("right" shape) to match a1
    ' "flip" the a1 array into a2
    For i = 1 To ub
        a2(i, 1) = a1(1, i)
    Next i

Create non contiguous Range skipping 5 rows with the same number of rows as the elements of the array

  For i = 5 + n To (5 + n) * (n_array - 1) Step 5
        If i = (5 + n) Then Set one_rng = ws.Range("B" & n)
        Set new_rng = ws.Range("B" & i)
        Set one_rng = Union(one_rng, new_rng)
    Next i

Insert array to range

one_rng = a2

score 1 · Answer 2 · answered Sep 18 '17 at 14:17

Do you 'need' vba or can you use excel-standard methods? If the later the easiest way in my opinion is the following:

Lets say your EXPL_1 etc. is from A1 to A....

Insert a column B and enter =countif($A$1:A1;A1) in B1.
Copy that formula down until the end of column A.
Sort your complete data by column B asc and column A asc
done :)

If you want to do it with vba you can use the same way with code:

Sub Mix_it()
    Columns(2).Insert
    Range(Range("B1"), Range("A" & Rows.Count).End(xlUp).Offset(0, 1)).Formula = "=COUNTIF($A$1:A1,A1)"
    Range(Range("X1"), Range("A" & Rows.Count).End(xlUp)).Sort Range("B1"), xlAscending, Range("A1"), , xlAscending ' change 'X' to last column
    Columns(2).Delete
End Sub

Doomenik · Answer 3 · 2017-09-18T12:32:59.313

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim EXPL_1 As Variant
EXPL_1 = Array("EXPL_1", "EXPL_1", "EXPL_1", "EXPL_1")  'For you it should store the csv content
Dim EXPL_2 As Variant
EXPL_2 = Array("EXPL_2", "EXPL_2", "EXPL_2")
Dim EXPL_3 As Variant
EXPL_3 = Array("EXPL_3", "EXPL_3")
Dim EXPL_4 As Variant
EXPL_4 = Array("EXPL_4")

Dim intCounter As Integer
intCounter = 0 'is our array index
Dim valueInserted As Boolean
valueInserted = False 'With this var we check if any value got inserted

Do
      valueInserted = False 'We reset it here so we dont run in an endless loop

      'Here we check if the array contains anything if not we just ignore that array until the others finished

      If UBound(EXPL_1) >= intCounter Then
        Debug.Print (EXPL_1(intCounter)) 'Write this row
        valueInserted = True
      End If
      If UBound(EXPL_2) >= intCounter Then
        Debug.Print (EXPL_2(intCounter)) 'Write this row
        valueInserted = True
      End If
      If UBound(EXPL_3) >= intCounter Then
        Debug.Print (EXPL_3(intCounter)) 'Write this row
        valueInserted = True
      End If
      If UBound(EXPL_4) >= intCounter Then
        Debug.Print (EXPL_4(intCounter)) 'Write this row
        valueInserted = True
      End If


      If valueInserted = False Then
        'If we didn´t inserted any value we exit the loop
        Exit Do
      End If
      intCounter = intCounter + 1
   Loop
End Sub

This can give you an idea how it would work. You sure will have to put some effort to seperate your CSV File in the 4 array but it should be done in some minutes. Hope it helps you.

Edit: Its now an working example it prints

EXPL_1
EXPL_2
EXPL_3
EXPL_4
EXPL_1
EXPL_2
EXPL_3
EXPL_1
EXPL_2
EXPL_1

Ok, if I understood right, your code should go to the Worksheet 1. But where are the results ? (I am not so expert in VBA). And how to make it to run ? — Bill Trapezanlidis, Sep 18 '17 at 13:20

score 0 · Accepted Answer · answered Sep 18 '17 at 12:10

 Sub MixData()
 Dim arr(5) As Long  'IF expl_5 is highest - increase as necessary
 Dim r As Range
 Dim x As Integer
 ActiveSheet.Columns(1).Insert
 Set r = Range("A1")
 Do
     x = Val(Mid(r.Offset(0, 1), 6, 1))
     arr(x) = arr(x) + 1
     r.Value = arr(x)
     Set r = r.Offset(1, 0)

 Loop Until r.Offset(0, 1) = ""
 ActiveSheet.UsedRange.Sort key1:=Range("a1")
 ActiveSheet.Columns("A").Delete
 End Sub