vba BitToLong

'Fast VBA function to converst binary string to a Long Integer:

Function BitsToLong&(bits$)
    Dim i&, b() As Byte
    If LenB(bits) > 64 Then Exit Function
    If LenB(bits) = 64 Then
        b = bits
    Else
        b = String$(32 - Len(bits), "0") & bits
    End If
    For i = 2 To 63 Step 2
        BitsToLong = 2 * BitsToLong Or (b(i) Xor 48)
    Next
    If (b(0) Xor 48) Then BitsToLong = BitsToLong Or &H80000000
End Function

'-----------------------------------------------------------------------------

MsgBox BitsToLong("1")									'<--displays:  1    
MsgBox BitsToLong("10")									'<--displays:  2
MsgBox BitsToLong("0110")								'<--displays:  6
MsgBox BitsToLong("0100101")							'<--displays:  37
MsgBox BitsToLong("100000000000000000000")				'<--displays:  1048576
MsgBox BitsToLong("11111111111111111111111111111111")	'<--displays:  -1
    

'VBA function to create a bitmask in a Long Integer:

Function BitMask&(ParamArray a())
    Dim i&, n&, m
    For i = 0 To UBound(a)
        If i > 31 Then Exit Function
        m = a(i)
        If m <> 0 Then
            If Len(m) Then
                BitMask = BitMask Or Abs(m) * 2 ^ i
            End If
        End If
    Next
End Function
  
'-----------------------------------------------------------------------------
  
Dim mask&
  
mask = BitMask(1, 0, 0, 0, 1)
MsgBox mask   '<--displays:  17         (00000000000000000000000000010001)

mask = BitMask(False, True, True)
MsgBox mask   '<--displays:  6          (00000000000000000000000000000110)

    
'-----------------------------------------------------------------------------
  
'The above function is fast. But for the fastest possible native code, 
'exponentiation (slow) can be optimized, by a lookup table. The following
'function uses the LeftShift() function, which is highly optimized. It is
'literally a hundred times faster:
  
Function BitMask&(ParamArray a())
    Dim i&, n&, m
    For i = 0 To UBound(a)
        If i > 31 Then Exit Function
        m = a(i)
        If m <> 0 Then
            If Len(m) Then
                BitMask = BitMask Or ShiftLeft(Abs(m), i)
            End If
        End If
    Next
End Function

Function ShiftLeft&(ByVal n&, Optional ByVal shifts& = 1)
    Dim d&
    Select Case shifts
        Case 1:  d = 2& * (n And 1073741823): If n And 1073741824 Then d = d Or &H80000000
        Case 2:  d = 4& * (n And 536870911):  If n And 536870912 Then d = d Or &H80000000
        Case 3:  d = 8& * (n And 268435455):  If n And 268435456 Then d = d Or &H80000000
        Case 4:  d = 16& * (n And 134217727): If n And 134217728 Then d = d Or &H80000000
        Case 5:  d = 32& * (n And 67108863):  If n And 67108864 Then d = d Or &H80000000
        Case 6:  d = 64& * (n And 33554431):  If n And 33554432 Then d = d Or &H80000000
        Case 7:  d = 128& * (n And 16777215): If n And 16777216 Then d = d Or &H80000000
        Case 8:  d = 256& * (n And 8388607):  If n And 8388608 Then d = d Or &H80000000
        Case 9:  d = 512& * (n And 4194303):  If n And 4194304 Then d = d Or &H80000000
        Case 10: d = 1024& * (n And 2097151): If n And 2097152 Then d = d Or &H80000000
        Case 11: d = 2048& * (n And 1048575): If n And 1048576 Then d = d Or &H80000000
        Case 12: d = 4096& * (n And 524287):  If n And 524288 Then d = d Or &H80000000
        Case 13: d = 8192& * (n And 262143):  If n And 262144 Then d = d Or &H80000000
        Case 14: d = 16384& * (n And 131071): If n And 131072 Then d = d Or &H80000000
        Case 15: d = 32768 * (n And 65535):   If n And 65536 Then d = d Or &H80000000
        Case 16: d = 65536 * (n And 32767&):  If n And 32768 Then d = d Or &H80000000
        Case 17: d = 131072 * (n And 16383&): If n And 16384& Then d = d Or &H80000000
        Case 18: d = 262144 * (n And 8191&):  If n And 8192& Then d = d Or &H80000000
        Case 19: d = 524288 * (n And 4095&):  If n And 4096& Then d = d Or &H80000000
        Case 20: d = 1048576 * (n And 2047&): If n And 2048& Then d = d Or &H80000000
        Case 21: d = 2097152 * (n And 1023&): If n And 1024& Then d = d Or &H80000000
        Case 22: d = 4194304 * (n And 511&):  If n And 512& Then d = d Or &H80000000
        Case 23: d = 8388608 * (n And 255&):  If n And 256& Then d = d Or &H80000000
        Case 24: d = 16777216 * (n And 127&): If n And 128& Then d = d Or &H80000000
        Case 25: d = 33554432 * (n And 63&):  If n And 64& Then d = d Or &H80000000
        Case 26: d = 67108864 * (n And 31&):  If n And 32& Then d = d Or &H80000000
        Case 27: d = 134217728 * (n And 15&): If n And 16& Then d = d Or &H80000000
        Case 28: d = 268435456 * (n And 7&):  If n And 8& Then d = d Or &H80000000
        Case 29: d = 536870912 * (n And 3&):  If n And 4& Then d = d Or &H80000000
        Case 30: d = 1073741824 * (n And 1&): If n And 2& Then d = d Or &H80000000
        Case 31: If n And &H1& Then d = &H80000000 Else d = &H0&
        Case 0:  d = n
    End Select
    ShiftLeft = d
End Function