Home » excel » What could be slowing down my Excel VBA Macro?

What could be slowing down my Excel VBA Macro?

Questions:

This function goes through all integers and picks out binary values with only five ones and writes them to the spreadsheet.

To run this `For x = 1 To 134217728` would take 2.5 days!!!! Help!

How could I speed this up?

``````Function D2B(ByVal n As Long) As String
n = Abs(n)
D2B = ""
Do While n > 0
If n = (n \ 2) * 2 Then
D2B = "0" & D2B
Else
D2B = "1" & D2B
n = n - 1
End If
n = n / 2
Loop
End Function

Sub mixtures()
Dim x As Long
Dim y As Integer
Dim fill As String
Dim RowOffset As Integer
Dim t As Date

t = Now

fill = ""

For x = 1 To 134217728
mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))

If x > 100000 Then Exit For

RowOffset = RowOffset + 1

For y = 1 To Len(mask)
Next
Next

Debug.Print DateDiff("s", Now, t)
End Sub
``````

By first sight guess, I think the problem lies in the fact that you do that cell by cell, which causes many read and write accesses.

You should do it range by range, like

``````vArr = Range("A1:C1000").Value
' it is array now, do something here effeciently
Range("A1:C1000").Value = vArr
``````

You want find all 28bit numbers with 5 1s

There are 28*27*26*25*24/5/4/3/2=98280 such numbers

The following code took ~10 seconds on my PC:

``````lineno = 1
For b1 = 0 To 27
For b2 = b1 + 1 To 27
For b3 = b2 + 1 To 27
For b4 = b3 + 1 To 27
For b5 = b4 + 1 To 27
Cells(lineno, 1) = 2 ^ b1 + 2 ^ b2 + 2 ^ b3 + 2 ^ b4 + 2 ^ b5
lineno = lineno + 1
Next
Next
Next
Next
Next
``````

``````mask = Right(fill & CStr(D2B(x)), Len(fill & CStr(D2B(x))))
``````

The above line of code does the same thing (`CStr(D2B(x))`) twice.
Store the result of `CStr(D2B(x))` in a variable & use that variable in the above line of code.

``````ws.Range(ws.cells(1, 1), ws.cells(UBound(dstArr, 1) + 1, UBound(dstArr, 2) + 1)) = dstArr