Converting Hex to Dec in VBA and making code efficent

Hi,

Wondering where this code can be adjusted to be much more efficient. Right now it is going through 1000 rows and 14 columns and it is taking about 10 minutes. I eventually need it to go through 6000 rows and 32 columns..

I already stored the HexToDec(Cells(x, 1)) result to variable H2D and it didn't really make too much of a noticeable difference.

Sub HexConversion()
Dim x As Integer, y As Integer
Dim H2D As Long

With Sheets("Floats")
    For x = 1 To 1000 'row number
       y = 11 'column K
       H2D = HexToDec(Cells(x, 1))
       Cells(x, y) = -(H2D > 32768)
       Cells(x, y + 1) = -((H2D - Cells(x, y) * 32768) >= 16384)
       Cells(x, y + 2) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384) >= 8192)
       Cells(x, y + 3) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192) >= 4096)
       Cells(x, y + 4) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096) >= 2048)
       Cells(x, y + 5) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048) >= 1024)
       Cells(x, y + 6) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024) >= 512)
       Cells(x, y + 7) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024 - Cells(x, y + 5) * 512) >= 256)
       Cells(x, y + 8) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024 - Cells(x, y + 5) * 512 - Cells(x, y + 6) * 256) >= 128)
       Cells(x, y + 9) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024 - Cells(x, y + 5) * 512 - Cells(x, y + 6) * 256 - Cells(x, y + 7) * 128) >= 64)
       Cells(x, y + 10) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024 - Cells(x, y + 5) * 512 - Cells(x, y + 6) * 256 - Cells(x, y + 7) * 128 - Cells(x, y + 8) * 64) >= 32)
       Cells(x, y + 11) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024 - Cells(x, y + 5) * 512 - Cells(x, y + 6) * 256 - Cells(x, y + 7) * 128 - Cells(x, y + 8) * 64 - Cells(x, y + 9) * 32) >= 16)
       Cells(x, y + 12) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024 - Cells(x, y + 5) * 512 - Cells(x, y + 6) * 256 - Cells(x, y + 7) * 128 - Cells(x, y + 8) * 64 - Cells(x, y + 9) * 32 - Cells(x, y + 10) * 16) >= 8)
       Cells(x, y + 13) = -((H2D - Cells(x, y) * 32768 - Cells(x, y + 1) * 16384 - Cells(x, y + 2) * 8192 - Cells(x, y + 3) * 4096 - Cells(x, y + 3) * 2048 - Cells(x, y + 4) * 1024 - Cells(x, y + 5) * 512 - Cells(x, y + 6) * 256 - Cells(x, y + 7) * 128 - Cells(x, y + 8) * 64 - Cells(x, y + 9) * 32 - Cells(x, y + 10) * 16 - Cells(x, y + 11) * 8) >= 4)
    Next x
End With
End Sub

I am using this Function to convert Hex to Dec since there is no VBA built in function, which I got from VBAExpress.com: http://www.vbaexpress.com/kb/getarticle.php?kb_id=307

Public Function HexToDec(Hex As String) As Double
     
    Dim i               As Long
    Dim j               As Variant
    Dim k               As Long
    Dim n               As Long
    Dim HexArray()      As Double
     
    n = Len(Hex)
    k = -1
    ReDim HexArray(1 To n)
    For i = n To 1 Step -1
        j = Mid(Hex, i, 1)
        k = k + 1
        Select Case j
        Case 0 To 9
            HexArray(i) = j * 16 ^ (k)
        Case Is = "A"
            HexArray(i) = 10 * 16 ^ (k)
        Case Is = "B"
            HexArray(i) = 11 * 16 ^ (k)
        Case Is = "C"
            HexArray(i) = 12 * 16 ^ (k)
        Case Is = "D"
            HexArray(i) = 13 * 16 ^ (k)
        Case Is = "E"
            HexArray(i) = 14 * 16 ^ (k)
        Case Is = "F"
            HexArray(i) = 15 * 16 ^ (k)
        End Select
    Next i
    HexToDec = Application.WorksheetFunction.Sum(HexArray)
     
End Function

Thanks