Home » excel » algorithm – Alternately mix DATA in MS EXCEL

algorithm – Alternately mix DATA in MS EXCEL

Posted by: admin April 23, 2020 Leave a comment

Questions:

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.

How to&Answers:
 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….

  1. Insert a column B and enter =countif($A$1:A1;A1) in B1.
  2. Copy that formula down until the end of column A.
  3. Sort your complete data by column B asc and column A asc
  4. 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