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.

```
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
```

### Answer：

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
```

### Answer：

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
```

### Answer：

```
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
```

Tags: algorithm, excelexcel