3

I looking to create an excel table which represents a binary sequence of up to 20 places, i.e. 2^20. I've looked into using the excel formula dec2bin, unfortunately it only produces a binary sequence up to 10 places, i.e. 2^10. I need to produce a binary sequence which is bigger.

I've had a stab at coding this up in vba, and suffer from a couple of problems when trying to solve the problem at small scale. First, my code produces a lot of duplicates. For example, when setting my table to 3 places, I produce 28 results when I should only get 8. Second, my code is pretty slow.

Any hints or tips for how I can produce a more robust table, at a quicker speed would be much appreciated!! And here is the code, at small scale I have been using...

Sub BinarySequence()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim Length As Integer

Application.ScreenUpdating = False

'Define 1st scenario
x = 1
Range("Start").Value = x 'where "Start" is defined as cell A1

'set default range
Length = Range("Sizei") 'where "Sizei" is defined as 3'
For i = 1 To Length
Range("start").Offset(0, i).Value = 1
Next

'code to generate first level binary sequence (i loop)
For i = 1 To Length

'code to generate second level binary sequence (j loop)
    For j = 1 To Length

'code to generate third level binary sequence (k loop)
        For k = 1 To Length

        x = x + 1
        Range("Start").Offset(0, i).Value = 0
        Range("Start").Offset(0, j).Value = 0
        Range("Start").Offset(0, k).Value = 0

'copy and paste scenario number
        Range("Start").Offset(x - 1, 0).Value = x

'copy and paste result
        Range("Result").Select 'where result is defined as row 1
        Selection.Copy
        Range("Result").Offset(x - 1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'reset scenario select for next loop
        Range("start").Offset(0, k).Value = 1
        Next k

'reset scenario select for next loop
    Range("start").Offset(0, j).Value = 1
    Next j

'reset scenario select for next loop
Range("Start").Offset(0, i).Value = 1
Next i

Application.ScreenUpdating = True

End Sub
Elliott White
  • 31
  • 2

2 Answers2

0

Reference this post for a VBA DecToBin function - https://groups.google.com/d/msg/comp.lang.visual.basic/KK_-zdrKmLQ/Y36tj5FenJcJ. If I understand the question correctly, you can use that Dec2Bin function with the following logic to generate the table (although it will take a while to do all 20 places):

    Sub BinaryTable()

        Size = 12
        StartingRow = 1
        RowIndex = StartingRow

        Application.ScreenUpdating = False

        For i = 0 To (2 ^ Size - 1)
            Cells(RowIndex, "A") = Dec2Bin(i, 20)
            RowIndex = RowIndex + 1
        Next

        Application.ScreenUpdating = True

    End Sub

Also, it can be important to be aware Excel's precision limits if your numbers get large enough.

Community
  • 1
  • 1
thephez
  • 362
  • 4
  • 12
  • This looks like a really elegant solution. Unfortunately I am getting a compile error: sub or function not defined message on the Dec2Bin function. I have looked up solutions to this problem online and have enabled my analysis toolpak - vba add in, for excel and also my atpvbaen.xls add in within the vba references menu. Unfortunately none of these fixes have worked. I'm using excel 2013, any further ideas on how I could fix this problem? – Elliott White Dec 18 '15 at 09:26
  • @ElliottWhite, Did you grab the Dec2Bin function from the first link in my answer? It is not an Excel provided function, so that could be the issue. The references I have turned on are Visual Basic for Applications, OLE Automation, Microsoft Excel 14.0 Object Library, and Microsoft Office 14.0 Object Library (I'm using Excel 2010). – thephez Dec 18 '15 at 13:51
  • Yeah, I'm using the same plug ins. Maybe its an Excel 2013 thing. That said, I've managed to adapt a difference code to create a binary sequence, which works and will post as an answer to my question. – Elliott White Jan 08 '16 at 10:47
  • Interesting. I just ran it in Excel 2013 and didn't have any issues. Maybe there's some obscure Excel setting that is different. – thephez Jan 11 '16 at 14:33
  • Regarding your code below (my reputation level won't let me comment there) - interacting with the actual Excel Worksheet is "expensive" in terms of processing time. I'd recommend passing "i" to the GetBinary function instead of reading it from the sheet. Also concatenate the value in the inner for loop and write the concatenated value back to the Worksheet just below the "Next CharLoop" statement - this will significantly cut down the number of writes to the sheet. I ran it with this modification and it took ~ 3 minutes to run through everything up to 2^20. – thephez Jan 11 '16 at 15:43
0

Solution taken and adapted from the excel forum. Here is a link to the relevant webpage: http://www.excelforum.com/excel-programming-vba-macros/741502-64-bit-binary.html

The macro isn't super quick, so this variation calculates around 340 lines per second. To create a binary sequence of 2^20, would take around an hour. Any suggestions for speeding up this macro would be gratefully received.

Function GetBinary(ByVal Dec) As String

Dim TmpBin
TmpBin = ""

While Dec > 0
  If Dec / 2 = Int(Dec / 2) Then
    TmpBin = TmpBin & "0"
  Else
    TmpBin = TmpBin & "1"
  End If
  Dec = Int(Dec / 2)
Wend

GetBinary = TmpBin

End Function

Sub Split()

Application.ScreenUpdating = False

Dim BinVal
Dim CharLoop
Dim i

For i = 0 To 32999

    BinVal = GetBinary(ActiveCell.Offset(i, 0).Value)

    For CharLoop = 1 To Len(BinVal)
        ActiveCell.Offset(i, CharLoop).Value = Mid(BinVal, CharLoop, 1)
    Next CharLoop

Next i

Application.ScreenUpdating = True

End Sub
Elliott White
  • 31
  • 2