I would like to shuffle my data. My input is like this:
1
2
3
4
5
Banana
4
8
9
12
1
Apple
7
10
10
7
13
Orange
7
7
9
2
14
Plum
5
8
8
2
12
Ananas
12
5
7
9
10
35
38
43
32
50
This is an example for 1 column, for all others is the same: In first column I have 4 Bananas, 7 apples, 7 oranges, 5 plums and 12 ananas so in total is 35 fruits. I would like to shuffle this data, so the output will be a column with 35 shuffled fruits.
The output for first column is like (length 35):
Banana
Apple
Orange
Plum
Banana
Ananas
Apple
Plum
Ananas
Banana
...
...
Apple
Orange
Banana
How to import this data, use this date, shuffle them and put the output in workhseet next to the table?
ok ignore my last post.
why 35 items? i'm assuming the first row is column identifiers and the last row is column totals.
can you explain how this shuffling will work?
FYI, I believe that "ananas" is "pineapple" in English.
As for the question, it's easy to create your output once you have the data. You've asked us how to import the data first though. How should we know? You haven't told us where this data is coming from and in what form. Is it a text file? Something else? If you want to deal with code then you have to be PRECISE. Vague descriptions are not enough because you can't write code to do something vague.
With regards to generating the output, I'm going to assume a Dictionary where the fruit names are the keys and the counts are the values. You can do something similar regardless of the actual data structure though. You simply loop through the fruits, create as many copies as the count, add them all to a single list and then order it randomly, e.g.
vb.net Code:
Dim countByFruit As New Dictionary(Of String, Integer)
I am a very beginner in VBA. I have this table in Excel and I would like to use this data (or as called in previous post 'import data' but as I noticed is wrong 'calling').
My first idea was in this way:
Dim FruitName(1 to 5) As String
FruitName(1)="Banana"
FruitName(2)="Apple"
FruitName(3)="Orange"
FruitName(4)="Plum"
FruitName(5)="Ananas"
Than I would like to "mix" all fruits that appear in one column (in other words: we have 4 bananas, 7 apples, 7 oranges, 5 plums and 12 ananas ORDERED in one box and now I would like to mix them-to be not ordered). My data are used in columns and the data in the last row is the sum of a column (additional info that you know, how many fruits are in 1 column or are mixed).
Last edited by mojih500; Jul 23rd, 2014 at 01:14 AM.
But are you a beginner to the Web? This is the VB.NET forum, for VB.NET questions. VBA questions belong in the Office Development forum, described thusly:
Post all your questions here regarding Microsoft Office Automation. This can include VSTO, VSTA, and VBA questions.
I have asked the mods to move this thread to the appropriate forum.
If you can demonstrate exactly what the "before" and "after" should look like we could probably help. A spreadsheet showing this would be best (you have to zip to attach).
I changed the data layout from what you attached. My workbook has 2 sheets, one called "Data" and the other called "Counts" with the Data sheet containing all the columns of fruits, starting in A1. I didn't put a lot of comments in this code, so ask if you have questions. It will sum the data on the Data sheet and put the totals on the Counts sheet:
Code:
Sub countFruit()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsCounts As Worksheet
Dim lr As Integer
Dim lc As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim fruits() As String
Dim qtys() As Integer
Dim fruitCount As Integer
Dim fruitFound As Boolean
Dim ro As Integer
Dim colTotal As Long
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("Data")
Set wsCounts = wb.Worksheets("Counts")
With wsData
lc = .Range("a1").End(xlToRight).Column 'get the last column's number
For j = 1 To lc
lr = .Cells(Rows.Count, j).End(xlUp).Row 'get the last row of the current column's data
ReDim fruits(0)
ReDim qtys(0)
fruitCount = 0
For k = 1 To lr
If k > 1 Then
fruitFound = False
For m = 0 To fruitCount
If .Cells(k, j) = fruits(m) Then
qtys(m) = qtys(m) + 1 'update the qty if this fruit is already in array
fruitFound = True
Exit For
End If
Next m
If fruitFound = False Then 'if this fruit is not in array yet, add it
fruitCount = fruitCount + 1
ReDim Preserve fruits(fruitCount)
ReDim Preserve qtys(fruitCount)
fruits(fruitCount) = .Cells(k, j)
qtys(fruitCount) = 1
End If
Else
fruits(0) = .Cells(k, j) 'put first fruit into array
qtys(0) = 1 'set first qty to 1
End If
Next k
fruitFound = False
If j > 1 Then
ro = wsCounts.Range("a" & Rows.Count).End(xlUp).Row
For m = 0 To fruitCount
fruitFound = False
For n = 2 To ro
If wsCounts.Cells(n, 1) = fruits(m) Then
fruitFound = True
wsCounts.Cells(n, j + 1) = qtys(m)
Exit For
End If
Next n
If fruitFound = False Then
wsCounts.Range("a" & ro + 1).Value = fruits(m)
wsCounts.Cells(ro + 1, j + 1) = qtys(m)
End If
Next m
Else
wsCounts.Cells.ClearContents
For m = 0 To fruitCount
wsCounts.Cells(m + 2, 1) = fruits(m)
wsCounts.Cells(m + 2, 2) = qtys(m)
Next m
End If
wsCounts.Cells(1, j + 1) = j
Next j
End With
lc = wsCounts.Range("b1").End(xlToRight).Column
For j = 2 To lc
colTotal = 0
lr = wsCounts.Cells(Rows.Count, j).End(xlUp).Row
For k = 2 To lr
colTotal = colTotal + wsCounts.Cells(k, j)
Next k
wsCounts.Cells(lr + 1, j) = colTotal
Next j
Set wsData = Nothing
Set wsCounts = Nothing
Set wb = Nothing
End Sub
If you know the total and the column of data, wouldn't you dim and array, loop through each type x number of times until you have an array of all the fruits.
Then to shuffle you could loop, say y number of times (may be 1000, 10000 or higher). Each time you loop you use rnd to generate a random number, multiply by total (x). Do this twice to get two positions, and switch the contents.
Admittedly this may mean the first and last entries might not swap so much, but you can do more maths on the random numbers to ensure more of a mix...
Feeling like a fly on the inside of a closed window (Thunk!)
If I post a lot, it is because I am bored at work! ;D Or stuck...
* Anything I post can be only my opinion. Advice etc is up to you to persue...
Thanks for the code, but I really don't understand what is the correct output.
I added worksheets "Data" and "Counts", where "Data" is my first sheet in example.xlsx, after running your program in worksheet "Counts" appear data which I don't understand if it correct or not. Please see the attached file and please tell me where I've made a mistake.
I completely misread your original request. My code in post #13 is not anywhere close to what you need. To clarify, you want to take your input count data and create the patterns you show in the area below the count data, right? If so, what is the logic to the "shuffle?" Do you want it to be completely random, or "weighted" depending on each fruit's count?
Yes correct, the output is the area below the "table". I would like to get symbols completely randomly mixed, depending on how many symbols are in each column.
With two sheets still (Data and Counts), with Data being empty, try this:
Code:
Sub shuffleFruits()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsCounts As Worksheet
Dim lr As Integer 'last row of description
Dim fTotal As Integer 'row with total
Dim lc As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim fruits() As String
Dim randoms() As Long
Dim tmpRand As String
Dim fruitPlusRand() As String
Dim upLimit As Long
Dim rngKey As Range
Dim splits() As String
Dim fruitCount As Integer
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("Data")
Set wsCounts = wb.Worksheets("Counts")
upLimit = 999999
wsData.Range("a1:z9999").ClearContents
With wsCounts
lr = .Range("a" & Rows.Count).End(xlUp).Row
lc = .Range("b1").End(xlToRight).Column
For j = 2 To lc
fTotal = .Cells(Rows.Count, j).End(xlUp)
ReDim fruits(fTotal - 1)
ReDim randoms(fTotal - 1)
ReDim fruitPlusRand(fTotal - 1)
fruitCount = 0
For k = 2 To lr
For m = fruitCount To (fruitCount + .Cells(k, j) - 1)
Randomize
fruits(m) = .Cells(k, 1)
randoms(m) = CLng(Rnd * (upLimit - 1) + 1)
Select Case randoms(m)
Case Is < 10
tmpRand = "00000" & randoms(m)
Case Is < 100
tmpRand = "0000" & randoms(m)
Case Is < 1000
tmpRand = "000" & randoms(m)
Case Is < 10000
tmpRand = "00" & randoms(m)
Case Is < 100000
tmpRand = "0" & randoms(m)
Case Else
tmpRand = randoms(m)
End Select
fruitPlusRand(m) = tmpRand & "^" & fruits(m)
fruitCount = fruitCount + 1
Next m
Next k
.Columns(lc + 2).EntireColumn.Clear
For k = 0 To fruitCount - 1
.Cells(k + 1, lc + 2) = fruitPlusRand(k)
Next k
Set rngKey = .Range(.Cells(1, lc + 2), .Cells(fruitCount, lc + 2))
With .Sort
.SortFields.Clear
.SortFields.Add rngKey
.SetRange rngKey
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For k = 1 To fruitCount
splits = Split(.Cells(k, lc + 2), "^")
wsData.Cells(k, j - 1) = splits(1)
Next k
Next j
End With
Set wsData = Nothing
Set wsCounts = Nothing
Set wb = Nothing
End Sub
lr = .Range("a" & Rows.Count).End(xlUp).Row ' counts number of different fruits(in our case 5 -Banana Apple Orange Plum Ananas)?
lc = .Range("b1").End(xlToRight).Column ' counts number of columns?
For j = 2 To lc
fTotal = .Cells(Rows.Count, j).End(xlUp) '????? when do you usually use End(xlUp)?
-------------------------------------------------------------
Select Case randoms(m)
Case Is < 10
tmpRand = "00000" & randoms(m)
Case Is < 100
tmpRand = "0000" & randoms(m)
Case Is < 1000
tmpRand = "000" & randoms(m) 'What exactly is doing this part?
Case Is < 10000
tmpRand = "00" & randoms(m)
Case Is < 100000
tmpRand = "0" & randoms(m)
Case Else
tmpRand = randoms(m)
------------------------------------------------------------
Set rngKey = .Range(.Cells(1, lc + 2), .Cells(fruitCount, lc + 2))
With .Sort
.SortFields.Clear
.SortFields.Add rngKey
.SetRange rngKey
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom ' 'What exactly is doing this part?
.SortMethod = xlPinYin
.Apply
End With
For k = 1 To fruitCount
splits = Split(.Cells(k, lc + 2), "^")
wsData.Cells(k, j - 1) = splits(1)
Next k
Next j
End With
As I understand the program is doing in this way:
- count number of rows, columns and number of each fruit in specific row/column
- create as many copies as the count is (all starts in 1 column)
- add them all to a single list and then order it randomly
lr = .Range("a" & Rows.Count).End(xlUp).Row ' counts number of different fruits(in our case 5...
this finds the row of the last filled cell in column A, so in our case the value is 6, and since the first fruit is in row 2, that give us our 5, yes.
lc = .Range("b1").End(xlToRight).Column ' counts number of columns?
yes
fTotal = .Cells(Rows.Count, j).End(xlUp) '????? when do you usually use End(xlUp)?
End(xlup) is the same as hitting Ctrl + Up in Excel, so use it to find the last filled cell in a specific column (in this case, column j, as in the variable "j")
tmpRand = "000" & randoms(m) 'What exactly is doing this part?
I'm generating a large random number (up to 999,999). This part sort of "formats" it to always have 6 characters, with leading zeros if needed, so I can sort it as a string later on.
.Orientation = xlTopToBottom ' 'What exactly is doing this part?
If you record a macro and perform a Data Sort, this is the code it generates. Try it using the different parameters (when recording).
You summary is pretty accurate, see attached sheet for a walkthrough of the steps.
starts in the last row in column F, and goes down, so in other words goes "nowhere," since it's already at the last row in the worksheet.
Which cell are you wanting to start from? F1? If you want to start with F1, then find the row of the last filled cell in the range (with no breaks), you would do this:
Reply With Quote
Originally Posted by mojih500
