Solved: Combination list using VBA

[kumar2008]

Hi,
I need to generate a list of 3 position codes using these letters/values:
A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,1,2,3,4,5,6,7,8,9,#,$

The only restriction is the 3 position values(codes) should not have all
numbers. It should always have atleast a minimum of one letter or special
character. That is: value 111 is not valid, however value 11A or A11 or 1A1 or, AA1 etc
are valid.

I looked into PERMUT funciton, but it does not help me.

I am not sure how many possible combination of 3 position alphanumeric values
can be generated and how do i code this in VBA.

Thanks

[CreganTur]

Welcome to the forum- always good to see new members!

Well... you have 54,872 possible combintations based on the 38 characters you defined.

Are you just trying to create a list of every possible combination, or do the values in this list need to correspond with something else?

Also, you said that "111" is an invalid result. Is "AAA" valid or invalid?

[kumar2008]

Thanks CreganTur! Vow, 54K odd combinations.

Yes, the 3 byte code just cannot have ALL numbers, but it can have all characters or all special characters. So, 111 is invalid, but AAA is valid. Can you please help how this can be coded in VBA?

thanks

[CreganTur]

Okay... the following code will create your list and house it as a string variable. Then it prints the value of the string variable to the Immediate Window- this is MUCH larger than what the Immedite Window can hold, so it only shows a tiny part of the results.

You'll need to modify this code so that something useful is done with the values. If you need help, let me know- just let me know what's supposed to be done with the values- individual cells in a worksheet, values of a combobox on a UserForm, etc.

[vba]Dim charArray
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim strShort As String
Dim strList As String
Dim firstChar As String
Dim secondChar As String
Dim thirdChar As String
charArray = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N" _
, "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3" _
, "4", "5", "6", "7", "8", "9", "#", "$")
For i = 0 To 37
firstChar = charArray(i)

For x = 0 To 37
secondChar = charArray(x)

For y = 0 To 37
thirdChar = charArray(y)

strShort = firstChar & secondChar & thirdChar
If Not (strShort = "111" Or strShort = "222" Or strShort = "333" Or _
strShort = "444" Or strShort = "555" Or strShort = "666" Or strShort = "777" _
Or strShort = "888" Or strShort = "999" Or strShort = "000") Then
strList = strList & strShort & vbCrLf
End If
Next
Next
Next
Debug.Print strList
[/vba]

NinjaEdit: a little explination of the code:

you'll notice that the For Next loops are designed to start at 0 and iterate to 37. This is because VBA starts its numbering at 0. So position 0 in the array is the character "A", and position 37 is the character "$". You can force Access to start numbering at 1 by using Option Base 1- this isn't necessary, it's just a personal choice based on your preference and if you can remember that Access starts at 0.

The nested loops work together to create all the various iterations.

[kumar2008]

Thank You so much, this code really helped me. I am trying to migrate a small application having around 20,000 fields and i needed to assign a unique 3 byte code to each one these fields. I have tweaked this code to omit certain restricted codes and it works just perfect for me. Thank You once again.

kumar

[CreganTur]

Thank You so much, this code really helped me. I am trying to migrate a small application having around 20,000 fields and i needed to assign a unique 3 byte code to each one these fields. I have tweaked this code to omit certain restricted codes and it works just perfect for me. Thank You once again.

kumar

I'm very happy I could help.

If your issue is resolved, then please help us out by clicking Thread Tools (at the top of the page) -> Mark as Solved. This will mark the thread as solved on the forum list

[hd_2721]

Hi CreganTur,

I would like to use your code to generate a fixed number of codes. For example, say I need only 50 generated codes, so the first one will be 001, then 002, 003, etc.. to 050.

Is there a way to make sure that when I run the program again it will start after the last generated code (in the above example it will start generating at 051 onwards)?

Thanks!

[CreganTur]

I looked into hd's request and made some changes to the code. On runtime 2 InputBoxes will appear, the first asking how many codes you want to generate, and the second asking for the last used code. If you leave the 2nd InputBox blank it will start generating from the beginning of the array.

Example:
I chose to generate 5 codes and left the 2nd InputBox blank, which gave me:

AAA
AAB
AAC
AAD
AAE

Then I re-ran the code, chose to generate 5 more codes and entered AAE as the last used code, which gave me:

AAF
AAG
AAH
AAI
AAJ

It still only outputs the codes into the Immediate Window by default, so you'll have to do the legwork to get it into your table- I would suggest an UPDATE query.

[vba]Sub DefineList()
Dim charArray
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim strShort As String
Dim strList As String
Dim firstChar As String
Dim secondChar As String
Dim thirdChar As String
Dim startCode As String
Dim oneChar As String, twoChar As String, threeChar As String
Dim oneStart As Integer, twoStart As Integer, threeStart As Integer
Dim counter As Integer, Desired As Integer
charArray = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N" _
, "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3" _
, "4", "5", "6", "7", "8", "9", "#", "$")
Desired = InputBox("Enter the number of codes you want to generate.")
counter = 0
startCode = StrConv(InputBox("Enter the last code created. (Leave blank to start fresh)"), vbUpperCase)
If startCode = "" Then
oneStart = 0
twoStart = 0
threeStart = 0
Else
oneChar = Left(startCode, 1)
twoChar = Mid(startCode, 2, 1)
threeChar = Right(startCode, 1)

For i = 0 To 37
If charArray(i) = oneChar Then
oneStart = i
Exit For
End If
Next
For i = 0 To 37
If charArray(i) = twoChar Then
twoStart = i
Exit For
End If
Next
For i = 0 To 37
If charArray(i) = threeChar Then
threeStart = i + 1
Exit For
End If
Next
End If
For i = oneStart To 37
firstChar = charArray(i)

For x = twoStart To 37
secondChar = charArray(x)

For y = threeStart To 37
thirdChar = charArray(y)

strList = firstChar & secondChar & thirdChar
Debug.Print strList
counter = counter + 1
If counter = Desired Then GoTo Completed_Run

Next
threeStart = 0
Next
twoStart = 0
Next
Completed_Run:
MsgBox Desired & " codes have been created."
End Sub
[/vba]

[hd_2721]

This is just beautiful! Thank you so much. Can't tell you how much I appreciate your help!!
I'm working on storing the output into an access table. The goal is to have Access automatically read the last generated code every time the program is run so that it would start generating the codes from where it left off the last time.
I may need help... Wish me luck!
Thanks again!