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 *