Generate all possible combinations of a set of numbers in excel - excel

How can I generate all possible combinations, in Excel, by using only 3, 6 and 9 in a 5 digit number? Naturally digits can repeat.
I am trying to learn more about EXCEL and this is something I cannot figure out - how to generate all possible combinations and see them instead of just having a number of possibilities.
I've looked through many forums, there's nothing I can use...
http://planetcalc.com/3756/?license=1 - This link is to an online generator, however there must be a mistake in its code since it doesn't show 5 digit numbers.

Just loop over the selections:
Sub Maja()
Dim K As Long
K = 1
vals = Array("3", "6", "9")
For Each a In vals
For Each b In vals
For Each c In vals
For Each d In vals
For Each e In vals
Cells(K, 1) = a & b & c & d & e
K = K + 1
Next e
Next d
Next c
Next b
Next a
MsgBox K
End Sub
A snap of the top of the list:
NOTE:
Technically, you would call these permutations rather than combinations because values like 33363 and 33336 both appear in the list as they represent different numerical values.

Related

How to count differences between Cells

I have VBA which comparing 2 cells. Each cell can contain between 1 and 3 different parameters ant parameters are trimmed by the "," comparison is made by simple double for loop(check code). Thing what i can't figure it out is that: How to modify code and get number of unique entries, example
cell 1 [music, art, science]; cell 2 [art, music]; When i run my for loops i get 2 matches(which is fine) but how to count number of unique words in this case should be 3.
I have tried to enter this part of code but its not working well num_possible = num_possible + 1
game_tags_parts = Split(Cells(11, 2), ",")
game_tags_parts_j = Split(Cells(11, j), ",")
num_matches = 0
num_possible = 0
For m = LBound(game_tags_parts) To UBound(game_tags_parts)
num_possible = num_possible + 1
For n = LBound(game_tags_parts_j) To UBound(game_tags_parts_j)
If Trim(game_tags_parts(m)) = Trim(game_tags_parts_j(n)) Then
num_matches = num_matches + 1
End If
Next n
Next m
Actual result should be number of unique words used in those cells, in some cases i get 3 matches, example cell 1 [scifi, space, star] cell 2 [star, space, scifi] and its in total 3 matches. Modification should provide me an number 3 as number of unique words used in both cells. Or in this case where i have cell 1 [art, music, science] and cell 2 [scifi, space, star] where program gives me 0 same words and modification should give me a number 6 as unique used words.
One easy way to get a unique count is to use a Dictionary object:
game_tags_parts = Split(Cells(11, 2), ",")
game_tags_parts_j = Split(Cells(11, j), ",")
Dim myDict As Object
Set myDict = CreateObject("Scripting.Dictionary")
For Each v In game_tags_parts
If Not myDict.Exists(v) Then myDict.Add v, v
Next v
For Each v In game_tags_parts_j
If Not myDict.Exists(v) Then myDict.Add v, v
Next v
MsgBox "unique count: " & myDict.Count

Generate passwords

I need generate passwords that do not repeat and do not have the same consecutive number, in addition to having a length of 8 digits, only numbers. All this in Visual Basic for applications Excel.
Well, if you only want numbers, a random number between 0 and 9 can be achieved by Int(Rnd() * 10).
Int() rounds down, Rnd() returns a number between 0 and <1.
If you then loop that 8 times and add the numbers after each other (with & rather than +) with an If checking the last last added value to the one we want to add, then you have an 8 digit number with no repeating numbers.
Then you just have to print or save them somewhere.
Something like:
Sub random()
Dim test As Long, ran As Long, i As Long, j As Long
For j = 1 To 500 '- Amount of numbers to print
ran = 0
For i = 1 To 8 '- Length of random number
test = Int(Rnd() * 10)
If test = Right(ran, 1) Then
i = i - 1 '-Same number, try again
Else
ran = ran & test '-New number, add this
End If
Next i
Range("A" & Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row).Value = ran '- Print on last row of column "A"
Next j
Range("A:A").RemoveDuplicates Columns:=1 '- Remove duplicates from column "A"
End Sub
This would then print 500 random 8 digit numbers starting from A2, or the last empty cell in column A. Then proceed with removing the duplicates.
You could check for duplicates each time, and thus making sure you actually end up with the specified amount of numbers. But it's extremely slow, and the chance to get a duplicate is really small (testrun of 10.000 numbers had a single duplicate for me).

How to write basic macro to compare two columns for a difference within .50?

I'm trying to write a macro that compares the differences between values in columns B and C. I'd like the macro to compare the two columns (B & C) and find depths that are within +/- .50 of each other, and I'd like to keep track of the sample # (column A) that corresponds to the sample depth that is within +/- .50 of the test depth, and then to find the difference between the sample depth and test depth. For example, the following images are before and after what I'd like the macro to look like:
Before:
After:
here you go. nested loop for the read, iterator to count the output row. May need some customization, but this is the core of it.
Sub foo()
Dim itr As Integer
itr = 2
For Each sd In Range("B:B")
If sd.Value = "" Then Exit For
If IsNumeric(sd.Value) Then
For Each td In Range("C:C")
If td.Value = "" Then Exit For
If IsNumeric(td.Value) Then
If Abs(sd.Value - td.Value) < 0.5 Then
Cells(itr, 5) = sd.Value
Cells(itr, 6) = td.Value
Cells(itr, 8) = sd.Value - td.Value
itr = itr + 1
End If
End If
Next td
End If
Next sd
End Sub

Inserting a Word in Excel Cell At Specified Position

In excel I have two columns A, B, C,D and E.In each row of column A, there is a paragraph. In the column B, C, D and E, there are four different words in front of each cell of column A. I want to PUT these 4 different words which are in column B, C, D and E into the paragraph present in column A cell. But all of these 4 words should be equally spaced throughout the paragraph. e.g 1 word should be in the beginning of the paragraph. And the rest of the three words should be equally spaced throughout the paragraph.
I have removed the leading and trailing spaces by applying "TRIM" function. The paragraph is composed of multiple lines with line breaks and multiple sub paragraphs.
Note: If the solution is flexible for more number of words e.g 7,8 or 9 words,then it will be great.
Following code might help. This is a UDF.
Function InsertWord(Source As String, InsWord As String, Pos As Integer)
Dim arr() As String
arr = Split(Source, " ")
wordCount = UBound(arr)
If wordCount < 1 Or (Pos - 1) > wordCount Or Pos < 0 Then
InsertWord = Source
Else
arr(Pos - 1) = arr(Pos - 1) & " " & InsWord
InsertWord = Join(arr, " ")
End If
End Function
See image for reference:

Names having same ID should come in one cell

I have different ids for for different names in excel. Many names having the the same ids. How to get all the names having same id in one cell correspondingly. I need formula. Please help me out
Is this what you're looking for? It'd have been nicer if you had shown your progress so far, but hope to be of help like this.
Option Explicit
Sub Concatenate_Names()
Dim a As Integer
Dim i As Integer
Dim x As Integer
i = 1
x = *[number of items in your list]*
For a = 1 To *[number of unique values in a separate list]*
i = 1
Do While i <= x
'The cell references should be dependent on where your unique value list is,
'as well as where the full list is.
'"a" for the unique values, "i" for the full list - matching IDs
If Cells(a, 8).Value = Cells(i, 1).Value Then
'"a" for the unique values, "i" for the full list - appending names
Cells(a, 9).Value = Cells(a, 9).Value & Cells(i, 2).Value
End If
i = i + 1
Loop
Next
End Sub
If you want to avoid the VBA aproach, you still can use recursive functions :
Add column to store a semantic representation with key / values, in my example, the representation schema is : #Key1:Value11[;Value12...][#Key2:Value21[;Value22...]...]
The formula bellow recursively builds such a representation, the last row will contain the complete representation of pairs key / values :
=IF(IFERROR(FIND("#"&A2&":";C1);-1)=-1;C1&"#"&A2&":"&B2;IF(IFERROR(FIND("#";C1;FIND("#"&A2&":";C1)+1);-2) = -2;LEFT(C1;FIND("#";C1;FIND("#"&A2&":";C1)+1)-1)&";"&B2;LEFT(C1;FIND("#";C1;FIND("#"&A2&":";C1)+1)-1)&";"&B2&RIGHT(C1;LEN(C1)-FIND("#";C1;FIND("#";C1;FIND("#"&A2&":";C1)+1)) + 1)))
Add a second new column to retrieve values associeted to current row / key, the formula uses the last computed representation :
=IFERROR(LEFT(RIGHT(INDEX(C:C;MATCH(REPT("z";255);C:C));LEN(INDEX(C:C;MATCH(REPT("z";255);C:C)))-FIND("#"&A2;INDEX(C:C;MATCH(REPT("z";255);C:C)))-1-LEN(A2));FIND("#";RIGHT(INDEX(C:C;MATCH(REPT("z";255);C:C));LEN(INDEX(C:C;MATCH(REPT("z";255);C:C)))-FIND("#"&A2;INDEX(C:C;MATCH(REPT("z";255);C:C)))-1-LEN(A2));2)-1);RIGHT(INDEX(C:C;MATCH(REPT("z";255);C:C));LEN(INDEX(C:C;MATCH(REPT("z";255);C:C)))-FIND("#"&A2;INDEX(C:C;MATCH(REPT("z";255);C:C)))-1-LEN(A2)))
The result should look like this :
Key Value Representation Values
1 a #1:a a;e;i
2 b #1:a#2:b b;h
3 c #1:a#2:b#3:c c;j
1 e #1:a;e#2:b#3:c a;e;i
5 f #1:a;e#2:b#3:c#5:f f
6 g #1:a;e#2:b#3:c#5:f#6:g g
2 h #1:a;e#2:b;h#3:c#5:f#6:g b;h
1 i #1:a;e;i#2:b;h#3:c#5:f#6:g a;e;i
3 j #1:a;e;i#2:b;h#3:c;j#5:f#6:g c;j

Resources