Home » excel » excel vba – Bitwise And with Large Numbers in VBA

# excel vba – Bitwise And with Large Numbers in VBA

Questions:

I keep getting an Overflow on the bitwise and in this first function. I fixed the other overflows by converting from Long to Currency (still seems weird), but I can’t get this And to work.

Any ideas? I’m just trying to convert some IP addresses to CIDRs and calculate some host numbers.

``````Option Explicit

Dim ipL As Variant
ipL = iPToNum(someIP)

Dim oneBit As Variant
oneBit = 2147483648#
oneBit = CDec(oneBit)
Dim CIDR As Integer
CIDR = 0

Dim x As Integer

For x = 31 To 0 Step -1
If (maskL And oneBit) = oneBit Then
CIDR = CIDR + 1
Else
Exit For
End If
oneBit = oneBit / 2# 'Shift one bit to the right (>> 1)
Next

End Function

Public Function NumHostsInCidr(CIDR As Integer) As Currency

End Function

Private Function maskFromCidr(ByVal CIDR As Integer) As Currency
'x = 32 - CIDR
'z = (2^x)-1
'return z xor 255.255.255.255
maskFromCidr = CLng(2 ^ ((32 - CIDR)) - 1) Xor 4294967295# '255.255.255.255
End Function

Private Function iPnumOfHosts(ByVal IPmsk As Currency) As Currency 'a mask for the host portion
'255.255.255.0 XOR 255.255.255.255 = 255 so 0 to 255 is 256 hosts
iPnumOfHosts = IPmsk Xor 4294967295# '255.255.255.255 , calculate the number of hosts
End Function

Private Function numToIp(ByVal theIP As Currency) As String 'convert number back to IP
Dim IPb(3) As Byte '4 octets
Dim theBit As Integer
theBit = 31 'work MSb to LSb
Dim x As Integer
For x = 0 To 3 'four octets
Dim y As Integer
For y = 7 To 0 Step -1 '8 bits
If (theIP And CLng(2 ^ theBit)) = CLng(2 ^ theBit) Then 'if the bit is on
IPb(x) = IPb(x) + CByte(2 ^ y) 'accumulate
End If
theBit = theBit - 1
Next
Next
End Function

Private Function iPToNum(ByVal ip As String) As Currency

Dim IPpart As Variant
Dim IPbyte(3) As Byte

IPpart = Split(ip, ".")
Dim x As Integer
For x = 0 To 3
IPbyte(x) = CByte(IPpart(x))
Next x

iPToNum = (IPbyte(0) * (256 ^ 3)) + (IPbyte(1) * (256 ^ 2)) + (IPbyte(2) * 256#) + IPbyte(3)

End Function

Private Function trimLast(str As String, chr As String)
'****
'*  Remove "chr" (if it exists) from end of "str".
'****
trimLast = str
If Right(str, 1) = chr Then trimLast = Left(str, Len(str) - 1)
End Function
``````

This is an entirely mathematical approach to working with IPv4 addresses in VBA (Excel specifically).

The first three functions are serving a strictly supporting role.

Support #1:

``````Public Function RoundDouble(ByVal Number As Double, ByVal Places As Long) As Double
On Error GoTo Err_RoundDouble

Dim i As Long
Dim j As Long

i = 0
j = 0

While Number < -(2 ^ 14)
Number = Number + (2 ^ 14)
i = i - 1
Wend
While Number > (2 ^ 14)
Number = Number - (2 ^ 14)
i = i + 1
Wend
While Number < -(2 ^ 5)
Number = Number + (2 ^ 5)
j = j - 1
Wend
While Number > (2 ^ 5)
Number = Number - (2 ^ 5)
j = j + 1
Wend

RoundDouble = Round(Number, Places) + (i * (2 ^ 14)) + (j * (2 ^ 5))

Exit_RoundDouble:
Exit Function

Err_RoundDouble:
MsgBox Err.Description
Resume Exit_RoundDouble

End Function
``````

Support #2:

``````Public Function RoundDownDouble(ByVal Number As Double, ByVal Places As Long) As Double
On Error GoTo Err_RoundDownDouble
Dim i As Double

i = RoundDouble(Number, Places)

If Number < 0 Then
If i < Number Then
RoundDownDouble = i + (10 ^ -Places)
Else
RoundDownDouble = i
End If
Else
If i > Number Then
RoundDownDouble = i - (10 ^ -Places)
Else
RoundDownDouble = i
End If
End If

Exit_RoundDownDouble:
Exit Function

Err_RoundDownDouble:
MsgBox Err.Description
Resume Exit_RoundDownDouble

End Function
``````

Support #3

``````Public Function ModDouble(ByVal Number As Double, ByVal Divisor As Double) As Double
On Error GoTo Err_ModDouble
Dim rndNumber As Double
Dim rndDivisor As Double
Dim intermediate As Double

rndNumber = RoundDownDouble(Number, 0)
rndDivisor = RoundDownDouble(Divisor, 0)

intermediate = rndNumber / rndDivisor
ModDouble = (intermediate - RoundDownDouble(intermediate, 0)) * rndDivisor

Exit_ModDouble:
Exit Function

Err_ModDouble:
MsgBox Err.Description
Resume Exit_ModDouble

End Function
``````

This first function will convert a Double back into an IP address.

``````Public Function NUMtoIP(ByVal Number As Double) As String
On Error GoTo Err_NUMtoIP

Dim intIPa As Double
Dim intIPb As Double
Dim intIPc As Double
Dim intIPd As Double

If Number < 0 Then Number = Number * -1

intIPa = RoundDownDouble(ModDouble(Number, (2 ^ 32)) / (2 ^ 24), 0)
intIPb = RoundDownDouble(ModDouble(Number, (2 ^ 24)) / (2 ^ 16), 0)
intIPc = RoundDownDouble(ModDouble(Number, (2 ^ 16)) / (2 ^ 8), 0)
intIPd = ModDouble(Number, (2 ^ 8))

NUMtoIP = intIPa & "." & intIPb & "." & intIPc & "." & intIPd

Exit_NUMtoIP:
Exit Function

Err_NUMtoIP:
MsgBox Err.Description
Resume Exit_NUMtoIP

End Function
``````

This second function is strictly to convert from IPv4 dotted octet format to a Double.

``````Public Function IPtoNUM(ByVal IP_String As String) As Double
On Error GoTo Err_IPtoNUM
Dim intIPa As Integer
Dim intIPb As Integer
Dim intIPc As Integer
Dim intIPd As Integer
Dim DotLoc1 As Integer
Dim DotLoc2 As Integer
Dim DotLoc3 As Integer
Dim DotLoc4 As Integer

DotLoc1 = InStr(1, IP_String, ".", vbTextCompare)
DotLoc2 = InStr(DotLoc1 + 1, IP_String, ".", vbTextCompare)
DotLoc3 = InStr(DotLoc2 + 1, IP_String, ".", vbTextCompare)
DotLoc4 = InStr(DotLoc3 + 1, IP_String, ".", vbTextCompare)

If DotLoc1 > 1 And DotLoc2 > DotLoc1 + 1 And _
DotLoc3 > DotLoc2 + 1 And DotLoc4 = 0 Then

intIPa = CInt(Mid(IP_String, 1, DotLoc1))
intIPb = CInt(Mid(IP_String, DotLoc1 + 1, DotLoc2 - DotLoc1))
intIPc = CInt(Mid(IP_String, DotLoc2 + 1, DotLoc3 - DotLoc2))
intIPd = CInt(Mid(IP_String, DotLoc3 + 1, 3))

If intIPa <= 255 And intIPa >= 0 And intIPb <= 255 And intIPb >= 0 And _
intIPc <= 255 And intIPc >= 0 And intIPd <= 255 And intIPd >= 0 Then

IPtoNUM = (intIPa * (2 ^ 24)) + (intIPb * (2 ^ 16)) + _
(intIPc * (2 ^ 8)) + intIPd

Else

IPtoNUM = 0

End If
Else
IPtoNUM = 0
End If

Exit_IPtoNUM:
Exit Function

Err_IPtoNUM:
MsgBox Err.Description
Resume Exit_IPtoNUM

End Function
``````

Next we have the conversion from an IPv4 address to it’s bitmask representation (assuming that the source entry is a string containing only the dotted octet format of the subnet mask).

``````Public Function IPtoBitMask(ByVal strIP_Address As String) As Integer

Exit Function

MsgBox Err.Description

End Function
``````

This last one is to convert a bitmask back into dotted octet format.

``````Public Function BitMasktoIP(ByVal intBit_Mask As Integer) As String

Exit Function

MsgBox Err.Description

End Function
``````

Edited to remove leftover debugging code (it’s been working for me so long, that I had entirely forgotten about it).

As an aside, it is faster to perform mathematical operations on a computer than it is to work with a string.

Whoah,
it is definitelly interesting functionality. But I would do this in very different way. I would treat IP adress and Mask as array of four bytes. Moreover as far as I remeber (well it was some time ago) CIDR and mask can be converted to each other in very simply way (did you looked at the table?). Why don’t you apply bitwise operations to each byte separatelly?
BR.

edit: ok I looked closer at the code. The reason why it is overflowing is that you can’t use `currency` and `and`. I think `and` is internally defined as Long and can’t return any bigger values. It is very common in other languages too. I remember that once I had this problem in other language (`Pascal`?). You can try to replace `and` by division. It will be slow but it can’t be matter here I suppose. Other solution is, like I wrote, to treat those valueas all the time as byte arrays and perform bitwise operations on each byte.

This was my “cheating” way:

``````Option Explicit

Dim strCIDR As String

Case "255.255.255.255":
strCIDR = "/32"
Case "255.255.255.254":
strCIDR = "/31"
Case "255.255.255.252":
strCIDR = "/30"
Case "255.255.255.248":
strCIDR = "/29"
Case "255.255.255.240":
strCIDR = "/28"
Case "255.255.255.224":
strCIDR = "/27"
Case "255.255.255.192":
strCIDR = "/26"
Case "255.255.255.128":
strCIDR = "/25"
Case "255.255.255.0":
strCIDR = "/24"
Case "255.255.254.0":
strCIDR = "/23"
Case "255.255.252.0":
strCIDR = "/22"
Case "255.255.248.0":
strCIDR = "/21"
Case "255.255.240.0":
strCIDR = "/20"
Case "255.255.224.0":
strCIDR = "/19"
Case "255.255.192.0":
strCIDR = "/18"
Case "255.255.128.0":
strCIDR = "/17"
Case "255.255.0.0":
strCIDR = "/16"
Case "255.254.0.0":
strCIDR = "/15"
Case "255.252.0.0":
strCIDR = "/14"
Case "255.248.0.0":
strCIDR = "/13"
Case "255.240.0.0":
strCIDR = "/12"
Case "255.224.0.0":
strCIDR = "/11"
Case "255.192.0.0":
strCIDR = "/10"
Case "255.128.0.0":
strCIDR = "/9"
Case "255.0.0.0":
strCIDR = "/8"
Case "254.0.0.0":
strCIDR = "/7"
Case "252.0.0.0":
strCIDR = "/6"
Case "248.0.0.0":
strCIDR = "/5"
Case "240.0.0.0":
strCIDR = "/4"
Case "224.0.0.0":
strCIDR = "/3"
Case "192.0.0.0":
strCIDR = "/2"
Case "128.0.0.0":
strCIDR = "/1"
Case "0.0.0.0":
strCIDR = "/0"

End Select

End Function
Public Function NumUsableIPs(cidr As String) As Long

Dim strHosts As String

If Len(cidr) > 3 Then
'They probably passed a whole address.

Dim slashIndex As String

slashIndex = InStr(cidr, "/")

If slashIndex = 0 Then
NumUsableIPs = 1
Exit Function
End If

cidr = Right(cidr, Len(cidr) - slashIndex + 1)

End If

Select Case cidr

Case "/32":
strHosts = 1
Case "/31":
strHosts = 0
Case "/30":
strHosts = 2
Case "/29":
strHosts = 6
Case "/28":
strHosts = 14
Case "/27":
strHosts = 30
Case "/26":
strHosts = 62
Case "/25":
strHosts = 126
Case "/24":
strHosts = 254
Case "/23":
strHosts = 508
Case "/22":
strHosts = 1016
Case "/21":
strHosts = 2032
Case "/20":
strHosts = 4064
Case "/19":
strHosts = 8128
Case "/18":
strHosts = 16256
Case "/17":
strHosts = 32512
Case "/16":
strHosts = 65024
Case "/15":
strHosts = 130048
Case "/14":
strHosts = 195072
Case "/13":
strHosts = 260096
Case "/12":
strHosts = 325120
Case "/11":
strHosts = 390144
Case "/10":
strHosts = 455168
Case "/9":
strHosts = 520192
Case "/8":
strHosts = 585216
Case "/7":
strHosts = 650240
Case "/6":
strHosts = 715264
Case "/5":
strHosts = 780288
Case "/4":
strHosts = 845312
Case "/3":
strHosts = 910336
Case "/2":
strHosts = 975360
Case "/1":
strHosts = 1040384

End Select

NumUsableIPs = strHosts

End Function
``````