How to round up with excel VBA round()? - excel

I have the following data:
cell(1,1) = 2878.75
cell(1,2) = $31.10
cell(2,1) = $89,529.13
However, when I tried to use round(cells(1,1).value*cells(1,2).value),2), the result does not match cell(2,1). I figured it has to do with the rounding issue, but I'm just wondering if it is possible to get round() to act normally. That is, for value > 0.5, round up. And for value < 0.5, round down?

VBA uses bankers rounding in an attempt to compensate for the bias in always rounding up or down on .5; you can instead;
WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)

If you want to round up, use half adjusting. Add 0.5 to the number to be rounded up and use the INT() function.
answer = INT(x + 0.5)

Try this function, it's ok to round up a double
'---------------Start -------------
Function Round_Up(ByVal d As Double) As Integer
Dim result As Integer
result = Math.Round(d)
If result >= d Then
Round_Up = result
Else
Round_Up = result + 1
End If
End Function
'-----------------End----------------

Try the RoundUp function:
Dim i As Double
i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)

I am introducing Two custom library functions to be used in vba, which will serve the purpose of rounding the double value instead of using WorkSheetFunction.RoundDown and WorkSheetFunction.RoundUp
Function RDown(Amount As Double, digits As Integer) As Double
RDown = Int((Amount + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function
Function RUp(Amount As Double, digits As Integer) As Double
RUp = RDown(Amount + (5 / (10 ^ (digits + 1))), digits)
End Function
Thus function Rdown(2878.75 * 31.1,2) will return 899529.12
and function RUp(2878.75 * 31.1,2) will return 899529.13
Whereas
The function Rdown(2878.75 * 31.1,-3) will return 89000
and function RUp(2878.75 * 31.1,-3) will return 90000

I had a problem where I had to round up only and these answers didnt work for how I had to have my code run so I used a different method.
The INT function rounds towards negative (4.2 goes to 4, -4.2 goes to -5)
Therefore, I changed my function to negative, applied the INT function, then returned it to positive simply by multiplying it by -1 before and after
Count = -1 * (int(-1 * x))

Math.Round uses Bankers rounding and will round to the nearest even number if the number to be rounded falls exactly in the middle.
Easy solution, use Worksheetfunction.Round(). That will round up if its on the edge.

Used the function "RDown" and "RUp" from ShamBhagwat and created another function that will return the round part (without the need to give "digits" for input)
Function RoundDown(a As Double, digits As Integer) As Double
RoundDown = Int((a + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function
Function RoundUp(a As Double, digits As Integer) As Double
RoundUp = RoundDown(a + (5 / (10 ^ (digits + 1))), digits)
End Function
Function RDownAuto(a As Double) As Double
Dim i As Integer
For i = 0 To 17
If Abs(a * 10) > WorksheetFunction.Power(10, -(i - 1)) Then
If a > 0 Then
RDownAuto = RoundDown(a, i)
Else
RDownAuto = RoundUp(a, i)
End If
Exit Function
End If
Next
End Function
the output will be:
RDownAuto(458.067)=458
RDownAuto(10.11)=10
RDownAuto(0.85)=0.8
RDownAuto(0.0052)=0.005
RDownAuto(-458.067)=-458
RDownAuto(-10.11)=-10
RDownAuto(-0.85)=-0.8
RDownAuto(-0.0052)=-0.005

This is an example j is the value you want to round up.
Dim i As Integer
Dim ii, j As Double
j = 27.11
i = (j) ' i is an integer and truncates the decimal
ii = (j) ' ii retains the decimal
If ii - i > 0 Then i = i + 1
If the remainder is greater than 0 then it rounds it up, simple. At 1.5 it auto rounds to 2 so it'll be less than 0.

Here's one I made. It doesn't use a second variable, which I like.
Points = Len(Cells(1, i)) * 1.2
If Round(Points) >= Points Then
Points = Round(Points)
Else: Points = Round(Points) + 1
End If

This worked for me
Function round_Up_To_Int(n As Double)
If Math.Round(n) = n Or Math.Round(n) = 0 Then
round_Up_To_Int = Math.Round(n)
Else: round_Up_To_Int = Math.Round(n + 0.5)
End If
End Function

I find the following function sufficient:
'
' Round Up to the given number of digits
'
Function RoundUp(x As Double, digits As Integer) As Double
If x = Round(x, digits) Then
RoundUp = x
Else
RoundUp = Round(x + 0.5 / (10 ^ digits), digits)
End If
End Function

The answers here are kind of all over the map, and try to accomplish several different things. I'll just point you to the answer I recently gave that discusses the forced rounding UP -- i.e., no rounding toward zero at all. The answers in here cover different types of rounding, and ana's answer for example is for forced rounding up.
To be clear, the original question was how to "round normally" -- so, "for value > 0.5, round up. And for value < 0.5, round down".
The answer that I link to there discusses forced rounding up, which you sometimes also want to do. Whereas Excel's normal ROUND uses round-half-up, its ROUNDUP uses round-away-from-zero. So here are two functions that imitate ROUNDUP in VBA, the second of which only rounds to a whole number.
Function RoundUpVBA(InputDbl As Double, Digits As Integer) As Double
If InputDbl >= O Then
If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl + 0.5 / (10 ^ Digits), Digits)
Else
If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl - 0.5 / (10 ^ Digits), Digits)
End If
End Function
Or:
Function RoundUpToWhole(InputDbl As Double) As Integer
Dim TruncatedDbl As Double
TruncatedDbl = Fix(InputDbl)
If TruncatedDbl <> InputDbl Then
If TruncatedDbl >= 0 Then RoundUpToWhole = TruncatedDbl + 1 Else RoundUpToWhole = TruncatedDbl - 1
Else
RoundUpToWhole = TruncatedDbl
End If
End Function
Some of the answers above cover similar territory, but these here are self-contained. I also discuss in my other answer some one-liner quick-and-dirty ways to round up.

My propose that is equal to Worksheetfunction.RoundUp
Function RoundUp(ByVal Number As Double, Optional ByVal Digits As Integer = 0) As Double
Dim TempNumber As Double, Mantissa As Double
'If Digits is minor than zero assign to zero.
If Digits < 0 Then Digits = 0
'Get number for x digits
TempNumber = Number * (10 ^ Digits)
'Get Mantisa for x digits
Mantissa = TempNumber - Int(TempNumber)
'If mantisa is not zero, get integer part of TempNumber and increment for 1.
'If mantisa is zero then we reach the total number of digits of the mantissa of the original number
If Mantissa <> 0 Then
RoundUp = (Int(TempNumber) + 1) / (10 ^ Digits)
Else
RoundUp = Number
End If
End Function

I got a workaround myself:
'G = Maximum amount of characters for width of comment cell
G = 100
'CommentX
If THISWB.Sheets("Source").Cells(i, CommentColumn).Value = "" Then
CommentX = ""
Else
CommentArray = Split(THISWB.Sheets("Source").Cells(i, CommentColumn).Value, Chr(10)) 'splits on alt + enter
DeliverableComment = "Available"
End If
If CommentX <> "" Then
'this loops for each newline in a cell (alt+enter in cell)
For CommentPart = 0 To UBound(CommentArray)
'format comment to max G characters long
LASTSPACE = 0
LASTSPACE2 = 0
If Len(CommentArray(CommentPart)) > G Then
'find last space in G length character string to make sure the line ends with a whole word and the new line starts with a whole word
Do Until LASTSPACE2 >= Len(CommentArray(CommentPart))
If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
ActiveCell.AddComment Left(CommentArray(CommentPart), LASTSPACE)
Else
If LASTSPACE2 = 0 Then
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Left(CommentArray(CommentPart), LASTSPACE)
Else
If Len(Mid(CommentArray(CommentPart), LASTSPACE2)) < G Then
LASTSPACE = Len(Mid(CommentArray(CommentPart), LASTSPACE2))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
Else
LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "þ", (Len(Mid(CommentArray(CommentPart), LASTSPACE2, G)) - Len(WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "")))))
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
End If
End If
End If
LASTSPACE2 = LASTSPACE + LASTSPACE2 + 1
Loop
Else
If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
ActiveCell.AddComment CommentArray(CommentPart)
Else
ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & CommentArray(CommentPart)
End If
End If
Next CommentPart
ActiveCell.Comment.Shape.TextFrame.AutoSize = True
End If
Feel free to thank me. Works like a charm to me and the autosize function also works!

Related

Converting a string of HH:MM:SS to numeric in VBA

The problem is pretty straight forward: convert the string representation into a number representing minutes. The only problem is that my code only works when I type the HH:MM:SS within a set of "". If the quotes are not included, the code runs but I get a #value error inside the cell in Excel. I figured this has to do with the length. With/without the quotes included, the code goes to the first index of the converted character array (or I should say the 0th). Here is my code:
Public Function TimeToDbl(val As String)
'Convert string into character array
Dim buff() As String
ReDim buff(Len(val) - 1)
For i = 1 To Len(val)
buff(i - 1) = Mid$(val, i, 1)
Next
'Separate hours,minutes,seconds
Dim h, m, s As Double
h = 0
m = 0
s = 0
For i = 1 To 2
h = (h * 10 ^ (i - 1)) + CInt(buff(i))
Next i
For i = 4 To 5
m = (m * 10 ^ (i - 4)) + CInt(buff(i))
Next i
For i = 7 To 8
s = (s * 10 ^ (i - 7)) + CInt(buff(i))
Next i
'Combine values centering minutes
s = s * 0.017
h = h * 60
m = h + m + s
TimeToInt = m
End Function
When passing a string with quotes, the quotes are included in the string. When the string is copied to an array, arr[0] becomes ". When passed without quotes, the text is still of type "string".
make a small change in the algorithm for h,m, and s shown below:
For i = 0 To 1
h = (h * (10 ^ i) + CInt(buff(i)))
Next i

Excel How to stop LEFT formula after meeting first Alpha in string

So i am trying to extract just a specific part of text strings (part numbers) for a vlookup,
I have got a formula that gives me the part number I want for most cases, which stops the LEFT formula after it reaches the last number in the text string. Some of the part numbers have more numbers further in the text string.
I need the formula to return the text string until the last number but to stop once it changes back to Alpha again.
I hope this makes sense I have attached a screenshot to example the issue and my code. If you look in column R and see the FR70YERXX/3, that should stop before the Y but i simply can't get my head round this one.
=LEFT(J2,MAX(IFERROR(FIND({1,2,3,4,5,6,7,8,9,0},J2,ROW(INDIRECT("1:"&LEN(J2)))),0)))
Put the following code into a module in Excel
Function LeftCode(s As String) As String
i = 1
While Not ((Mid(s, i, 1) >= "0") And (Mid(s, i, 1) <= "9")) And (i <= Len(s))
i = i + 1
Wend
If i > Len(s) Then
LeftCode = s
Else
While Not ((Mid(s, i, 1) < "0") Or (Mid(s, i, 1) > "9")) And (i <= Len(s))
i = i + 1
Wend
If i > Len(s) Then
LeftCode = s
Else
LeftCode = Left(s, i - 1)
End If
End If
End Function
Then in column R type:
=LeftCode(J2)
and copy this down
Explanation
Create a function to take a string and return a string
Function LeftCode(s As String) As String
Starting at the first character, loop through the string one character at a time until you find a digit (0-9)
i = 1
While Not ((Mid(s, i, 1) >= "0") And (Mid(s, i, 1) <= "9")) And (i <= Len(s))
i = i + 1
Wend
If we have reached the end, with no numbers, then return it all
If i > Len(s) Then
LeftCode = s
Otherwise continue to loop through each character until we find a non digit
Else
While Not ((Mid(s, i, 1) < "0") Or (Mid(s, i, 1) > "9")) And (i <= Len(s))
i = i + 1
Wend
If we reach the end then we want the whole thing
If i > Len(s) Then
LeftCode = s
Else
Otherwise we want up to the last but one character
LeftCode = Left(s, i - 1)
End If
End If
End Function
It seems you want to to truncate until the first combination of digit is followed by non-digit. If so try this:
=LEFT(H2,AGGREGATE(15,6,ROW($1:$98)
/ISNUMBER(VALUE(MID(H2,ROW($1:$98),1)))
/ISERROR(VALUE(MID(H2,ROW($2:$99),1))),1))
Solution 1
Well I can give a long ugly looking formula if you are willing to use. Try this
=-LOOKUP(1,-LEFT(MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),LEN(A1)-MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789"))+1),ROW(INDIRECT("1:"&LEN(MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),LEN(A1)-MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"0123456789"))+1))))))
See image for reference.
Solution 2
Using helper column
In Cell B2 enter the following formula to get the position of first number
=MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A2&"0123456789"))
Then in Cell C2 to get the string after removing alphabets preceding first number, enter
=RIGHT(A2,LEN(A2)-B2+1)
Finally, in Cell D2 enter the below formula
=IFERROR(-LOOKUP(1,-LEFT(C2,ROW(INDIRECT("1:"&LEN(C2))))),"")
Drag/Copy down as required. See image for reference.

Reconstructing string after parsing and modifying numbers from it in Lua

I have strings like the following (quotation marks are only showing that there may be leading and trailing whitespaces), and I need to extract the numbers from the string, which may be integer or float, negative or non-negative.
" M0 0.5 l 20 0 0 20.34 -20 0q10 0 10 10 t 10 10 54.333 10 h -50 z"
After extracting the numbers I have to multiply them with random numbers, which the following function produces.
-- returns a random float number between the specified boundaries (floats)
function random_in_interval(lower_boundary, upper_boundary)
return ((math.random() * (upper_boundary - lower_boundary)) + lower_boundary)
end
At the end reconstruct the string with the characters and multiplied numbers in the correct order. Also all this has to happen in Lua, and I can't use any external libraries, since this will be used in a LuaTeX compiled document.
The case of the characters must not be changed, characters may or may not have spaces before and after them, but in the output it would be nice if there were. I have already written a helper function to add whitespace before and after characters, however when a character has a whitespace before or after it this will introduce multiple whitespaces, which I cannot solve at the moment.
-- adds whitespace before and after characters
function pad_characters(str)
local padded_str = ""
if #str ~= 0 then
for i = 1, #str, 1 do
local char = string.sub(str, i, i)
if string.match(char, '%a') ~= nil then
padded_str = padded_str .. " " .. char .. " "
else
padded_str = padded_str .. char
end
end
end
-- remove leading and trailing whitespaces
if #padded_str ~= 0 then
padded_str = string.match(padded_str, "^%s*(.-)%s*$")
end
return padded_str
end
I have no idea how I could parse, modify the numeric parts of the string, and reconstruct it in the correct order, and doing this in pure Lua without using any external libraries.
Try this. Adapt as needed.
s=" M0 0.5 l 20 0 0 20.34 -20 0q10 0 10 10 t 10 10 54.333 10 h -50 z"
print(s:gsub("%S+",function (x)
local y=tonumber(x)
if y then
return y*math.random()
else
return x
end
end))
I couldn't come up with anything better than processing each character, and decide if it is a number (digit, decimal point, negative sign) or anything else and act according to it.
-- returns a random float number between the specified boundaries (floats)
function random_in_interval(lower_boundary, upper_boundary)
return ((math.random() * (upper_boundary - lower_boundary)) + lower_boundary)
end
-- note: scaling is applied before randomization
function randomize_and_scale(str, scale_factor, lower_boundary, upper_boundary)
local previous_was_number = false
local processed_str = ""
local number = ""
for i = 1, #str, 1 do
local char = string.sub(str, i, i)
if previous_was_number then
if string.match(char, '%d') ~= nil or
char == "." then
number = number .. char
else -- scale and randomize
number = number * scale_factor
number = number * random_in_interval(lower_boundary, upper_boundary)
processed_str = processed_str .. number .. char
number = ""
previous_was_number = false
end
else
if string.match(char, '%d') ~= nil or
char == "-" then
number = number .. char
previous_was_number = true
else
processed_str = processed_str .. char
-- apply stuff
previous_was_number = false
end
end
end
return processed_str
end

Truncating Double with VBA in excel

I need to truncate the amount of decimal places of my double value for display in a textbox. How would one achieve this with vba?
If you want to round the value, then you can use the Round function (but be aware that VBA's Round function uses Banker's rounding, also known as round-to-even, where it will round a 5 up or down; to round using traditional rounding, use Format).
If you want to truncate the value without rounding, then there's no need to use strings as in the accepted answer - just use math:
Dim lDecimalPlaces As Long: lDecimalPlaces = 2
Dim dblValue As Double: dblValue = 2.345
Dim lScale = 10 ^ lDecimalPlaces
Dim dblTruncated As Double: dblTruncated = Fix(dblValue * lScale) / lScale
This yields "2.34".
You can either use ROUND for FORMAT in VBA
For example to show 2 decimal places
Dval = 1.56789
Debug.Print Round(dVal,2)
Debug.Print Format(dVal,"0.00")
Note: The above will give you 1.57. So if you are looking for 1.56 then you can store the Dval in a string and then do this
Dim strVal As String
dVal = 1.56789
strVal = dVal
If InStr(1, strVal, ".") Then
Debug.Print Split(strVal, ".")(0) & "." & Left(Split(strVal, ".")(1), 2)
Else
Debug.Print dVal
End If
You can use Int() function. Debug.print Int(1.99543)
Or Better:
Public Function Trunc(ByVal value As Double, ByVal num As Integer) As Double
Trunc = Int(value * (10 ^ num)) / (10 ^ num)
End Function
So you can use Trunc(1.99543, 4) ==> result: 1.9954
This was my attempt:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End Function
It uses strings to avoid any math errors caused by different rounding methods. It will output as a type double, so you can still perform your own math on it.
This will cause an error if a number without a decimal place is passed into the above function. If this is a concern, you can use the following code instead:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
If InStr(decimalNum, ".") = 0 Then 'if there was no decimal:
'then return the number that was given
TruncateNumber = decimalNum
Else 'if there is a decimal:
'then return the truncated value as a type double
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End If
End Function
Hopefully these functions are of some use to someone. I haven't done extensive testing, but they worked for me.
EDITED
Newer version of Excel (VBA) have a TRUNC function which already does things properly.
For older versions of EXCEL
I wanted to truncate a double into an integer.
value = Int(83.768)
value == 83
Awesome, it worked.
Depending on your version of Excel (VB) this might not work with negative numbers.
value = Int(-83.768)
value == -84
VB uses Banker rounding.
Public Function Trunc1(ByVal value As Double) As Integer
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc1 = Sgn(value) * Int(Abs(value))
End Function
If you want specific decimal places do what Makah did only with Abs around the value so Int can truncate properly.
Public Function Trunc2(ByVal value As Double, Optional ByVal num As Integer = 1) As Double
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc2 = Sgn(value) * (Int(Abs(value) * (10 ^ num)) / (10 ^ num))
End Function
Here is a little experiment I did... (1st time posting and answer, please tell me if I am not following conventions.
Sub Truncate()
Dim dblNum As Double
Dim intDecimal As Integer
dblNum = 1578.56789
intDecimal = 2 '0 returns 1578
'2 returns 1578.56
'-2 returns 1500
Debug.Print (Int(dblNum * 10 ^ intDecimal) / 10 ^ intDecimal)
End Sub

How can you convert HEX to BIN, one character at a time in EXCEL 2010

I am trying to find a way to take a string of HEX values and convert them to BIN. I need to convert 1 HEX character at a time:
For example: HEX = 0CEC
BIN = 0000 1100 1110 1100
I need to do this in Excel. Any help would be great.
Thanks,
Larry
In a module:
Public Function HEX2BIN(strHex As String) As String
Dim c As Long, i As Long, b As String * 4, j As Long
For c = 1 To Len(strHex)
b = "0000"
j = 0
i = Val("&H" & Mid$(strHex, c, 1))
While i > 0
Mid$(b, 4 - j, 1) = i Mod 2
i = i \ 2
j = j + 1
Wend
HEX2BIN = HEX2BIN & b & " "
Next
HEX2BIN = RTrim$(HEX2BIN)
End Function
For:
=HEX2BIN("0CEC")
0000 1100 1110 1100
Yes, I had to do this recently. I'm late to the game, but other people will have to do this from time to time, so I'll leave the code where everyone can find it:
Option Explicit
Public Function HexToBinary(strHex As String, Optional PadLeftZeroes As Long = 5, Optional Prefix As String = "oX") As String
Application.Volatile False
' Convert a hexadecimal string into a binary
' As this is for Excel, the binary is returned as string: there's a risk that it will be treated as a number and reformatted
' Code by Nigel Heffernan, June 2013. Http://Excellerando.Blogspot.co.uk THIS CODE IS IN THE PUBLIC DOMAIN
' Sample Usage:
'
' =HexToBinary("8E")
' oX0010001110
'
' =HexToBinary("7")
' oX001111
'
' =HexToBinary("&HD")
' oX01101
Dim lngHex As Long
Dim lngExp As Long
Dim lngPad As Long
Dim strOut As String
Dim strRev As String
If Left(strHex, 2) = "&H" Then
lngHex = CLng(strHex)
Else
lngHex = CLng("&H" & strHex)
End If
lngExp = 1
Do Until lngExp > lngHex
' loop, bitwise comparisons with successive powers of 2
' Where bitwise comparison is true, append "1", otherwise append 0
strRev = strRev & CStr(CBool(lngHex And lngExp) * -1)
lngExp = lngExp * 2
Loop
' As we've done this in ascending powers of 2, the results are in reverse order:
If strRev = "" Then
HexToBinary = "0"
Else
HexToBinary = VBA.Strings.StrReverse(strRev)
End If
' The result is padded by leading zeroes: this is the expected formatting when displaying binary data
If PadLeftZeroes > 0 Then
lngPad = PadLeftZeroes * ((Len(HexToBinary) \ PadLeftZeroes) + 1)
HexToBinary = Right(String(lngPad, "0") & HexToBinary, lngPad)
End If
HexToBinary = Prefix & HexToBinary
End Function
You can use HEX2BIN(number, [places]).
The HEX2BIN function syntax has the following arguments:
Number Required. The hexadecimal number you want to convert. Number cannot contain more than 10 characters. The most significant bit of number is the sign bit (40th bit from the right). The remaining 9 bits are magnitude bits. Negative numbers are represented using two's-complement notation.
Places Optional. The number of characters to use. If places is omitted, HEX2BIN uses the minimum number of characters necessary. Places is useful for padding the return value with leading 0s (zeros).
I would use a simple formula as follows:
=HEX2BIN(MID(S23,1,2))&HEX2BIN(MID(S23,3,2))&HEX2BIN(MID(S23,5,2))&HEX2BIN(MID(S23,7,2)&HEX2BIN(MID(S23,9,2)&HEX2BIN(MID(S23,11,2)&HEX2BIN(MID(S23,13,2))
cell S23 = BFBEB991, Result = 10111111101111101011100110010001
This would allow it to be as long you need. Just add as many repetitions as you need incrementing the start position by 2 (eg 1, 3, 5, 7, 9, 11, 13, 15, ....). Note that the missing characters will be ignored.
For me, it gives this (sorry, in VBA, but has the advantage of not asking you the length of your string to convert). Be careful, I put a comment in the lower part for which you can add a space between each section of 4 bits. Some don't want the space and some will need it:
Length = Len(string_to_analyse)
For i = 1 To Length
Value_test_hexa = Left(Right(string_to_analyse, Length - (i - 1)), 1)
'get the asci value of each hexa character (actually can work as a decimal to binary as well)
Value_test = Asc(Value_test_hexa)
If Value_test > 47 And Value_test < 58 Then
Value_test = Value_test - 48
End If
' Convert A to F letters to numbers from 10 to 15
If Value_test > 64 And Value_test < 71 Then
Value_test = Value_test - 55
End If
'identify the values of the 4 bits for each character (need to round down)
a = WorksheetFunction.RoundDown(Value_test / 8, 0)
b = WorksheetFunction.RoundDown((Value_test - a * 8) / 4, 0)
c = WorksheetFunction.RoundDown((Value_test - a * 8 - b * 4) / 2, 0)
d = (Value_test - a * 8 - b * 4 - c * 2)
Value_converted = Value_converted & a & b & c & d ' can eventually add & " " in order to put a space every 4 bits
Next i
Tested OK so you can go with it.
Just leaving this here for anyone who needs it.
Instead of manually converting from hex to binary, I used Excel's built-in HEX2BIN function.
Function hexToBin(hexStr As String) As String
Dim i As Integer, b As String, binStr As String
For i = 1 To Len(hexStr)
b = Application.hex2bin(Mid(hexStr, i, 1), 4)
binStr = binStr & b
Next i
hexToBin = binStr
End Function

Resources