VBA Bitwise operators

In VBA there are no bitwise operators, those similar to “” operators in C++ and Visual Basic. Do this mean we can’t do bit shift operations?. Following this post from Excely, we can replicate bitwise shift operators with multiplying or dividing by the appropriate power of 2. The original post code was far from optimized and did not behave well in several possible situations we can deal with. The code presented here have some amedments, beeing the main to have a buffer with the shifters to optimize the operations, and some checkings in the code just to get not trapped in overflow errors.
Option Explicit

Private aShifter() As Long ' Buffer for the shift operations

Private Function fBitwiser() As Boolean
' Compute the shifters and store in buffer
Dim lgShift As Long

    ReDim aShifter(0 To 30) ' overflow for 2^31 and 2^32
    aShifter(0) = 1 '2^0
    For lgShift = 1 To 30
        aShifter(lgShift) = aShifter(lgShift - 1) * 2 '2^lgShift
    Next lgShift
End Function

Public Sub sBitwiseTest()
    Dim Value As Long
    Dim strHex1 As String
    Dim strHex2 As String

    Value = &H90000000
    strHex1 = "&H" & Hex(shr(Value, 1))
    strHex2 = "&H" & Hex(shl(strHex1, 1))
End Sub

Public Function shr(ByVal Value As Long, _
                    ByVal shift As Byte) As Long
' Right shifting is equal to dividing by 2^shift
' Bitwise Right Shift Function
    Dim bSgn As Boolean

    If Not (Not aShifter()) Then Else Call fBitwiser

    If shift > 30 Then GoTo ErrControl

    If Value  0) Then Value = Value - 1
            shr = Not Value
        Else
            shr = Value
        End If
    Else
        Value = 0
    End If

    Exit Function
ErrControl:
    Dim lgRetVal As Long
    lgRetVal = VBA.MsgBox("Can not operate on 32 bits", vbExclamation + vbOKOnly)
End Function

Public Function shl(ByVal Value As Long, _
                    ByVal shift As Byte) As Long
' Left shifting is equal to multiplying by 2^Shift. 
' Bitwise Left Shift Function
    If Not (Not aShifter()) Then Else Call fBitwiser

    shl = Value

    If shift > 0 Then
        Dim i As Long
        Dim m As Long
        If Value < aShifter(30 - shift) Then
            Value = Value * aShifter(shift)
        Else
            ' To avoid an overflow error we'd use small trick:
            For i = 1 To Shift
                m = Value And &H40000000                    ' save 30th bit
                Value = Value And &H3FFFFFFF                ' clear 30th and 31st bits
                Value = Value * 2                           ' multiply by 2
                If m  0 Then Value = Value Or &H80000000  ' set 31st bit
            Next i
        End If
        shl = Value
    End If
End Function

Public Function DecToBin(ByVal lngDec As Long) As String
' Decimal-to-Binary function that converts a Long Integer value
' (max value range -2^31 to 2^31 or -2147483648 to 2147483647)
' to binary number represented by a string:

' Sample Results:
'-----------------------------
' Print DecToBin(32768)
' 00000000000000001000000000000000
' Print DecToBin(32769)
' 00000000000000001000000000000001
' Print DecToBin(2 ^ 31 - 1)
' 01111111111111111111111111111111
' Print DecToBin(2147483647)
' 01111111111111111111111111111111
' Print DecToBin(-2 ^ 31)
' 10000000000000000000000000000000
' Print DecToBin(-2147483648#)
' 10000000000000000000000000000000
' Print DecToBin(2 ^ 31)
' Overflow error

    Const MAXLEN = 30
    Dim strBin As String
    Dim n As Long

    If Not (Not aShifter()) Then Else Call fBitwiser

    If lngDec < 0 Then strBin = "1" Else strBin = "0"

    For n = MAXLEN To 0 Step -1
        If (lngDec And aShifter(n)) Then
            strBin = strBin & "1"
        Else
            strBin = strBin & "0"
        End If
    Next

    DecToBin = strBin

End Function
[/sourcecode]

Leave a Reply

Your email address will not be published. Required fields are marked *