×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
• Keyword Search
Favorite Forums
• Automated Signatures
• Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

#### Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

# VBA Visual Basic for Applications (Microsoft) FAQ

 Forum Search FAQs Links MVPs

## VBA How To

Working with binary data by Bong
Posted: 13 Sep 06 (Edited 7 May 08)

More and more, I'm using VBA (in Excel) to make tools that produce test data or analyze real data.  Those data are frequently binary telemetry.  I found that VBA is short on obvious binary functions (except for HEX, there are none) and so came up with some of my own (with help from the kind experts on this forum).  Should this be of interest to anyone else, here are some of my most used.

1.  Convert a binary string to a hex string:

#### CODE

Function b2h(bstr)
'convert binary string to hex string
cnvarr = Array("0000", "0001", "0010", "0011", _
"0100", "0101", "0110", "0111", "1000", _
"1001", "1010", "1011", "1100", "1101", _
"1110", "1111")
'find number of HEX digits
a = Len(bstr)
ndgt = a / 4
If (a Mod 4 > 0) Then
MsgBox ("must be integer multiple of 4Bits")
Exit Function
End If
hstr = ""
For i = 1 To ndgt
dgt = Mid(bstr, (i * 4) - 3, 4)
For k = 0 To 15
If (dgt = cnvarr(k)) Then
ix = k
End If
Next
hstr = hstr & Hex(ix)
Next
b2h = hstr
End Function

2.  Convert a hex string to a binary string:

#### CODE

Function h2b(hstr)
'convert hex string to binary string
cnvarr = Array("0000", "0001", "0010", "0011", _
"0100", "0101", "0110", "0111", "1000", _
"1001", "1010", "1011", "1100", "1101", _
"1110", "1111")
bstr = ""
For i = 1 To Len(hstr)
hdgt = Mid(hstr, i, 1)
cix = CInt("&H" & hdgt)
bstr = bstr & cnvarr(cix)
Next
h2b = bstr
End Function

3.  convert a binary string to a decimal number:

#### CODE

Function b2d(bstr)
'convert binary string to decimal number
numbits = Len(bstr)
asum = 0
For i = 1 To numbits
asum = asum + Mid(bstr, i, 1) * 2 ^ (numbits - i)
Next
b2d = asum
End Function

4.  convert a decimal number to IEEE floating point (32 bit; 8 hex characters) hex string:

#### CODE

Function i3efp(num_in)
s = 0
If num_in < 0 Then s = 1
For e = 0 To 255
If 2 * 2 ^ (e - 127) > Abs(num_in) Then Exit For
Next
If e = 0 Then GoSub toosmall
If e = 255 Then GoSub toobig
f = (Abs(num_in) / (2 ^ (e - 127))) - 1
f = 1 * Right(f, Len(f) - 2)
f = (f * 10 ^ -Len(f)) / 2 ^ -23
eh = Hex(e)
If Len(eh) < 2 Then eh = "0" & eh
fh = Hex(f)
i3eb = s & h2b(eh)  '9 bits
fb = Right(h2b(fh), 23)
If Len(fb) < 23 Then fb = String(23 - Len(fb), "0") & fb
i3eb = i3eb & fb    '32 bits
i3efp = b2h(i3eb)
Exit Function
toobig:
i3efp = String(8, "F")
Exit Function
toosmall:
i3efp = String(8, "0")
Exit Function
End Function

5. And, of course, convert a 32-bit IEEE-formatted hex string to a decimal number:

#### CODE

Function i3e2d(hstr)
If Len(hstr) <> 8 Then
i3e2d = "invalid input"
Exit Function
End If
bstr = h2b(hstr)
sgnbit = Left(bstr, 1)
s = (-1) ^ sgnbit
expnt = Mid(bstr, 2, 8)
e = b2d(expnt) - 127
mntss = Right(bstr, 23)
f = b2d(mntss)
f = (f * 2 ^ -23) / 10 ^ -Len(f)
i = InStr(1, f, ".")
If i > 0 Then f = Left(f, i - 1)
f = 1 * ("0." & Trim(Str(f))) + 1
i3e2d = s * 2 ^ e * f
End Function

6.  Open a file of (as) binary data, read a byte (at a time) as a HEX string:
[note (7-May-08): Thanks to Ken Sailor for finding an error.  I had used AscB to read a byte as a number.  It sometimes fails.  It should be Asc]

#### CODE

Open filename For Binary As #1
. . .
a1 = Asc(Input(1, #1))
h1 = Hex(a1)
If Len(h1) < 2 Then
h1 = "0" & h1
End If
. . .
close #1

7. I like to write out binary data as both ASCII HEX and binary:

#### CODE

Open filename & ".asc" For Output As #1
Open filename & ".bin" For Binary As #2
. . .
'for example, building a hex string from cells
For rw = 2 To ActiveSheet.UsedRange.Rows.Count
If (Cells(rw, 2) = "") Then Exit For
wrd = Cells(rw, 5) & Cells(rw, 6) & Cells(rw, 7) _
& Cells(rw, 8) & "00000"
Print #1, wrd
GoSub bin_out
Next
Close #1
Close #2
Exit Sub
bin_out:
wrdlen = Len(wrd)
For bix = 1 To wrdlen - 1 Step 2
bnum = Mid(wrd, bix, 2)
bnum2 = b2d(h2b(bnum))
uvar$= Chr(bnum2) Put #2, , uvar$
Next
Return

8. Two's Complement representation of negative integers
input HEX string (hs), return a Long:

#### CODE

Function twoscomp(hs)
bs = h2b(hs)
If Left(bs, 1) = "1" Then
bcs = Replace(bs, "1", "q")
bcs = Replace(bs, "0", "1")
bcs = Replace(bs, "q", "0")
twoscomp = -1 * (CLng("&H" & b2h(bs)) + 1)
Else
twoscomp = CLng("&H" & hs)
End If
End Function

Back to VBA Visual Basic for Applications (Microsoft) FAQ Index
Back to VBA Visual Basic for Applications (Microsoft) Forum

Close Box

# Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!