bin2hex

[Dan]

I have read the recent post on this sujbect but need some additional help. I
have a data stream with a potential 64+ bits and I need to convert to HEX.

Dim Value&, i&, Base#: Base = 1
For i = Len(Binary) To 1 Step -1
Value = Value + IIf(Mid(Binary, i, 1) = "1", Base, 0)
Base = Base * 2
Next i
BinToHex = Hex(Value)

This function fails after 31 bits due to the HEX(Value) function. I have
modifed the code as follows:

Dim i&, j&, k&, l&, Base1#: Base1 = 1
Dim Base2#: Base2 = 1
Dim Base3#: Base3 = 1
Dim Base4#: Base4 = 1
Dim Value1 As Variant
Dim Value2 As Variant
Dim value3 As Variant
Dim value4 As Variant
Dim binary As Variant
Dim binary1 As Variant
Dim binary2 As Variant
Dim Binary3 As Variant
Dim Binary4 As Variant

Set binary = Worksheets("Sheet1").Range("C5")
binary1 = Mid(binary, 1, 16)
binary2 = Mid(binary, 17, 16)
Binary3 = Mid(binary, 33, 16)
Binary4 = Mid(binary, 49, 16)

For i = Len(binary1) To 1 Step -1
Value1 = Value1 + IIf(Mid(binary1, i, 1) = "1", Base1, 0)
Base1 = Base1 * 2
Next i

For j = Len(binary2) To 1 Step -1
Value2 = Value2 + IIf(Mid(binary2, j, 1) = "1", Base2, 0)
Base2 = Base2 * 2
Next j

For k = Len(Binary3) To 1 Step -1
value3 = value3 + IIf(Mid(Binary3, k, 1) = "1", Base3, 0)
Base3 = Base3 * 2
Next k

For l = Len(Binary4) To 1 Step -1
value4 = value4 + IIf(Mid(Binary4, l, 1) = "1", Base4, 0)
Base4 = Base4 * 2
Next l

If Not value4 = "" Then
BinToHex = Hex(Value1) & Hex(Value2) & Hex(value3) & Hex(value4)
ElseIf Not value3 = "" Then
BinToHex = Hex(Value1) & Hex(Value2) & Hex(value3)
ElseIf Not Value2 = "" Then
BinToHex = Hex(Value1) & Hex(Value2)
Else
BinToHex = Hex(Value1)
End If
MsgBox BinToHex

Is there a simpler way to have a BIN2HEX function that is not limited to "X"
bits?

Thanks

 

[Tom Ogilvy]

Function BIN2HEX(sBin As String)
Dim tot As Long, r As Long, j As Long
Dim i As Long, s1 As String, s As String
r = Len(sBin) Mod 4
If r <> 0 Then _
sBin = Left("000", 4 - r) & sBin
For i = 1 To Len(sBin) Step 4
s1 = Mid(sBin, i, 4)
tot = 0
For j = 3 To 0 Step -1
tot = tot + (2 ^ j) * Mid(s1, 4 - j, 1)
Next
s = s & Hex(tot)
Next
BIN2HEX = s
End Function

should be able to handle any length.

 

[Dan]

Excellent. Works great.

Function BIN2HEX(sBin As String)
Dim tot As Long, r As Long, j As Long
Dim i As Long, s1 As String, s As String
r = Len(sBin) Mod 4
If r <> 0 Then _
sBin = Left("000", 4 - r) & sBin
For i = 1 To Len(sBin) Step 4
s1 = Mid(sBin, i, 4)
tot = 0
For j = 3 To 0 Step -1
tot = tot + (2 ^ j) * Mid(s1, 4 - j, 1)
Next
s = s & Hex(tot)
Next
BIN2HEX = s
End Function

should be able to handle any length.