excel vba binary string to hex string code example

Example 1: excel vba string to binary

'VBA function to convert text to a binary string representation:

Public Function TextToBinaryString$(s$)
    Dim c&, i&, lo&, bin$(0 To 255), d() As Byte
    Const ZEROS$ = "00000000"
    For c = 0 To 255
        bin(c) = ZEROS
        If c And 1& Then MidB$(bin(c), 15) = "1"
        If c And 2& Then MidB$(bin(c), 13) = "1"
        If c And 4& Then MidB$(bin(c), 11) = "1"
        If c And 8& Then MidB$(bin(c), 9) = "1"
        If c And 16& Then MidB$(bin(c), 7) = "1"
        If c And 32& Then MidB$(bin(c), 5) = "1"
        If c And 64& Then MidB$(bin(c), 3) = "1"
        If c And 128& Then MidB$(bin(c), 1) = "1"
    Next
    d = s
    lo = 1
    TextToBinaryString = Space$(LenB(s) * 8)
    For i = 0 To LenB(s) - 1 Step 2
        Mid$(TextToBinaryString, lo) = bin(d(i + 1))
        Mid$(TextToBinaryString, lo + 8) = bin(d(i))
        lo = lo + 16
    Next
End Function
            
'------------------------------------------------------------------------------
            
MsgBox TextToBinaryString("Hi")  '<--displays: 00000000010010000000000001101001

Example 2: excel vba binary string to hexidecimal string

'Fast VBA function to convert binary string to hexadecimal string...

Function BinToHex$(bin$, Optional groupBy& = 1)
    Dim c&, i&, j&, hNdx&, nibble&, bits$, s$
    Dim b() As Byte, h() As Byte
    Static bHexChars() As Byte, pow2() As Byte
    
    Const HEX_CHARS$ = "0123456789ABCDEF"
    If (Not Not bHexChars) = 0 Then bHexChars = StrConv(HEX_CHARS, vbFromUnicode)
    If (Not Not pow2) = 0 Then pow2 = ChrW$(&H201) & ChrW$(&H804)

    b = StrConv(bin, vbFromUnicode)
    ReDim h(0 To -Int(-Len(bin) / 4) - 1)
    hNdx = UBound(h)
    
    For i = UBound(b) To 0 Step -1
        If b(i) = 49& Then nibble = nibble + pow2(c)
        c = c + 1
        If c = 4 Then
            h(hNdx) = bHexChars(nibble)
            hNdx = hNdx - 1
            nibble = 0
            c = 0
        End If
    Next
    If c Then h(hNdx) = bHexChars(nibble)
    BinToHex = StrConv(h, vbUnicode)
    
    If groupBy > 1 Then
        i = Len(BinToHex) + 1
        Do
            i = i - groupBy
            If i < 1 Then
                s = " " & Mid$(BinToHex, 1, i + groupBy - 1) & s
                Exit Do
            End If
            s = " " & Mid$(BinToHex, i, groupBy) & s
        Loop While i
        BinToHex = Trim$(s)
    End If
End Function

'-------------------------------------------------------------------------------

binaryStr = "11111100110101011110001101000110"

MsgBox BinToHex(binaryStr)      '<--displays: FCD5E346
MsgBox BinToHex(binaryStr, 4)   '<--displays: FCD5 E346
MsgBox BinToHex(binaryStr, 2)   '<--displays: FC D5 E3 46


'Note: this is an extremely fast and optimized function that can convert
'      an arbitrarily large binary string to hex.
'
'
'