Ones and Zeros String

[cdo3]

Hi!

I'm looking for some ideas(help) on creating a string generator that will create a string that starts with "0000" go through every combonation of ones and zeros (example, "0100", "0010", "0001", "1011&quot and end with "1111"

Thanks in advance.
Steve

 

[MichaelRed]

????????

WHY would you ever do this programatically? There are )ONLY!) 16 possible combinations, and it is faster to just write the, than to generate the Permutations program to generate them.

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[PaulF]

This may be "Non-Technical" but it'll work

Private Sub cmdGetBinary_Click()
Dim x As Integer
For x = 0 To 15
MsgBox "X is: " & x & ", And Binary is: " & fReturnBinary(x)
Next x
End Sub

Function fReturnBinary(varItem As Variant)
Dim intRemain As Integer
Select Case varItem
Case 0
fReturnBinary = "0000"
Case 1
fReturnBinary = "0001"
Case 2
fReturnBinary = "0010"
Case 3
fReturnBinary = "0011"
Case 4
fReturnBinary = "0100"
Case 5
fReturnBinary = "0101"
Case 6
fReturnBinary = "0110"
Case 7
fReturnBinary = "0111"
Case 8
fReturnBinary = "1000"
Case 9
fReturnBinary = "1001"
Case 10
fReturnBinary = "1010"
Case 11
fReturnBinary = "1011"
Case 12
fReturnBinary = "1100"
Case 13
fReturnBinary = "1101"
Case 14
fReturnBinary = "1110"
Case 15
fReturnBinary = "1111"
Case Else
MsgBox "Invalid Value"
End Select
End Function

PaulF

 

[cdo3]

Thanks for responding so quickly.

The actual string is ten char long. I used four to try and keep is simple. If I could find some one to help me create a generator I could then expand it to innclude all ten char.

I'm currently using a backend table that contans all of the combonations. I thought it might be faster to search throught them if I had somthing that would create every possable combonation to find a matching string the user enters. This is an inherited DB.

These are used to identify which parts are needed to create a kit. Example: "1101". The first digit means that a bolt is needed, the second means a nut is needed, the third no flat washer and the fourth a lock washer is needed.

Steve

 

[PaulF]

are there only 10 fields that need to be checked, and are these fields Yes/No fields? if so you can create a function to make a string value based on each of those ten fields

StringValue: Abs([fld1]) & Abs([fld2]) & Abs([fld3]) & Abs([fld4]) & Abs([fld5]) & Abs([fld6]) & Abs([fld7]) & Abs([fld8]) & Abs([fld9]) & Abs([fld10])

PaulF

 

[MichaelRed]

O.K.

Public Function basBinStr(ValIn As Long, _
                          Optional MaxLen As Integer = 10) _
                          As String

    'Michael Red, 11/26/2001
    'Function to return the Binary representation of 
    'A Numeric (Long) The optional "MaxLen" is just the 
    'number of "Characters" of the string to Return (from
    'the RIGHT!)  Used just to generate all the possible
    'combinations of "1" and "0" within a fixed filed size
    '(up to 32)

    Dim CurVal As Long
    Dim TempVal As Long
    Dim Indx As Integer
    Dim RtnStr As Variant
    Dim TmpStr As String
    Dim BitSet(30) As String * 1

    Indx = 0
    Do While Indx <= UBound(BitSet)
        BitSet(Indx) = &quot;0&quot;
        Indx = Indx + 1
    Loop

    RtnStr = &quot;0&quot;
    CurVal = ValIn

    Indx = UBound(BitSet)
    Do Until Indx < 0
        TempVal = CurVal - (2 ^ Indx)
        If (TempVal >= 0) Then
            'This Bit Needs to Be Set,
            'The String is A &quot;1&quot; & Indx - 1 Zeroes
            BitSet(Indx) = 1
            CurVal = CurVal - 2 ^ Indx
        End If
        Indx = Indx - 1
    Loop

    Indx = UBound(BitSet)
    Do Until Indx < 0
        RtnStr = RtnStr & BitSet(Indx)
        Indx = Indx - 1
    Loop
    basBinStr = right(RtnStr, MaxLen)

End Function

Public Function basAllBins()

    'Function to Demonstrate basBinStr function
    'Which is just to create &quot;Bit&quot; patterns

    'Michael Red, 11/26/2001

    Dim Idx As Long

    Idx = 0
    Do While Idx <= 2047
        Debug.Print basBinStr(Idx, 11)
        Idx = Idx + 1
    Loop
End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[cdo3]

Thanks for response to my request. I was impressed with how fast you guys came up with a solution. I worked a hole day trying to figure it out. I wish I could think that fast. I've desided to use the code that MichaelRed presented. It worked great and is soooo mush faster then using the table methed. Thanks Michael.

Thanks again all.

Steve