Related
there. I made this code that replaces a character for two number (e.g. 0 = 10; 1 = 11; 2 = 12; ...) and everything works fine except for the first element (the zero element). So, if I put "010a4" string on cell A1 and use my formula "=GENERATECODE(A1)", my expected return value is "1011102014" but I've got a "110111102014" string. So, only zero value occur this error and I can't figured out why. Any thoughts?
My code:
Function GENERATECODE(Code As String)
Dim A As String
Dim B As String
Dim i As Integer
Const AccChars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const RegChars = "1011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071"
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, 2 * i - 1, 2)
Code = Replace(Code, A, B)
Next
GENERATECODE = Code
End Function
Your problem is that your code first change each 0 to 10 then each 1 to 11. So each 0 give you 10 then 110.
If you want to keep the same kind of algorithm (which might not be a good choice), you need to change AccChars and RegChars so that a character is never replaced by a string that can give a character found later on the AccChars String. In your case just replace Const AccChars = "012 ... per Const AccChars = "102 ... and Const RegChars = "101112 ... per Const RegChars = "111012 ...
But it might be better to change your algorithm altogether. I would first suggest to not use in place editing of the string, but rather to use 2 Strings.
In addition to being incorrect, your current code is inefficient since it involves scanning over the code string multiple times instead of just once. Simply scan over the string once, gathering the substitutions into an array which is joined at the end:
Function GENERATECODE(Code As String) As String
Dim codes As Variant
Dim i As Long, n As Long
Dim c As String
n = Len(Code)
ReDim codes(1 To n)
For i = 1 To n
c = Mid(Code, i, 1)
Select Case c
Case "0" To "9":
codes(i) = "1" & c
Case "a" To "z":
codes(i) = Asc(c) - 77
Case "A" To "Z":
codes(i) = Asc(c) - 19
Case Else:
codes(i) = "??"
End Select
Next i
GENERATECODE = Join(codes, "")
End Function
Example:
?generatecode("010a4")
1011102014
The point of the two offsets is that you want "a" to map to 20 and "A" to map to 46. Note Asc("a") - 77 = 97 - 77 and Asc("A") - 19 = 65-19 = 46.
I am trying to convert accented characters to regular characters. Some characters need to be replaced with two characters. I tried MID(string,i,2).
Function ChangeAccent(thestring As String)
Dim A As String * 1
Dim B As String * 1
Dim C As String * 1
Dim D As String * 1
Dim i As Integer
Const LatChars="ßÄÖÜäöü"
Const OrgChars= "SSAEOEUEaeoeue"
For i = 1 To Len(LatChars)
A = Mid(LatChars, i, 1)
B = Mid(OrgChars, i, 2)
thestring = Replace(thestring, A, B)
Next
Const AccChars="ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars= "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
For i = 1 To Len(AccChars)
C = Mid(AccChars, i, 1)
D = Mid(RegChars, i, 1)
thestring = Replace(thestring, C, D)
Next
ChangeAccent = thestring
End Function
The code is working for one by one replacement (1 character by 1 character).
I want to replace one character in the variable LatChars with 2 characters in OrgChars. i.e ß with SS, Ä with AE and so on.
The Mid(OrgChars, i,2) is not extracting two characters.
Minor changes:
Dim B As String * 2
B = Mid(OrgChars, i * 2 - 1, 2)
Option Explicit
Function ChangeAccent(thestring As String)
Dim A As String * 1
Dim B As String * 2
Dim C As String * 1
Dim D As String * 1
Dim i As Integer
Const LatChars = "ßÄÖÜäöü"
Const OrgChars = "SSAEOEUEaeoeue"
For i = 1 To Len(LatChars)
A = Mid(LatChars, i, 1)
B = Mid(OrgChars, i * 2 - 1, 2)
thestring = Replace(thestring, A, B)
Next
Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
For i = 1 To Len(AccChars)
C = Mid(AccChars, i, 1)
D = Mid(RegChars, i, 1)
thestring = Replace(thestring, C, D)
Next
ChangeAccent = thestring
End Function
B = Mid(OrgChars, i,2)
Should probably be
B = Mid(OrgChars, i*2-1,2)
One method is to use two arrays. One that contains the character you wish to replace and the other its replacement. This method depends on both arrays being in sync with one another. Element 1 in the first array must match element 1 in the second, and so on.
This method allows you to ignore the string lengths. There is no longer any need to process 1 and 2 character replacement strings separately. This code can also scale to 3, 4 or more character replacements without a logic change.
I've used the split function to build the arrays. I find this saves time when typing out the code. But you may prefer to define the elements individually, which is arguably easier to read.
Example
Sub Demo001()
' Demos how to replace special charaters of various lenghts.
Dim ReplaceThis() As String ' Array of characters to replace.
Dim WithThis() As String ' Array of replacement characters.
Dim c As Integer ' Counter to loop over array.
Dim Sample As String ' Contains demo string.
' Set up demo string.
Sample = "ß - Ä - Š"
' Create arrays using split function and comma delimitor.
ReplaceThis = Split("ß,Ä,Š", ",")
WithThis = Split("SS,AE,S", ",")
' Loop over replacements.
For c = LBound(ReplaceThis) To UBound(ReplaceThis)
Sample = Replace(Sample, ReplaceThis(c), WithThis(c))
Next
' Show result.
MsgBox Sample
End Sub
Returns
SS - AE - S
EDIT: Answer rewritten as first attempt misunderstood - and did not answer - op question
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!
Is it Possible in VBScript to convert such 20:72:84(hh:mm:ss) duration to 21:13:24 (hh:mm:ss) format?
Yes obviously we can Loop through it but I want to avoid such Loopy technique.
CODE
As per the Siddharth solution - I just modified the code as it to fit with VBScript platform
Option Explicit
Dim S
S=Convert("23:61:61")
MsgBox(s)
Function Convert(strTime) 'As String
Dim timeArray()
Dim h , m , s
MsgBox("Hi")
'On Error Resume Next
timeArray = Split(strTime, ":")
h = timeArray(0): m = timeArray(1): s = timeArray(2)
REM If err then
REM MsgBox(err)
REM err.clear
REM Exit Function
REM End if
Do Until s < 60
s = s - 60
m = m + 1
Loop
Do Until m < 60
m = m - 60
h = h + 1
Loop
Do Until h < 24
h = h - 24
Loop
Convert = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")
'on Error Goto 0
'Exit Function
'Whoa:
'Convert = "Error! CYDD!" '<~~ CYDD : Check Your Data Dude :)
End Function
EDIT1 I am getting an error as Type mismatch to the line timeArray = Split(strTime, ":")
Thanks,
Split the array
Add each part to an empty time using dateadd()
rebuild the time to a well formatted string using a stringbuilder
' This splits the string in an hours, minutes and seconds part.
' the hours will be in dArr(0), minutes in dArr(1) and seconds in dArr(2)
dArr = split("20:72:84", ":")
' Add the hours to an empty date and return it to dt1
dt1 = dateadd("h", dArr(0), empty)
' Add the minutes to dt1. Note: Minutes are noted as "n" and not "m" because the
' "m" is reserved for months. To find out more about the dateadd() please look here:
' http://www.w3schools.com/vbscript/func_dateadd.asp
' When the minutes are bigger than they fit in the date, it automatically falls over to
' next hour.
dt1 = dateadd("n", dArr(1), dt1)
' Also add the seconds (the third part of the array) to dt1, also the seconds
' automatically fall over when too large.
dt1 = dateadd("s", dArr(2), dt1)
' Now that we created a date, we only have to format it properly. I find it the most easy
' way to do this is with a dotnet stringbuilder, because we can separate code and
' format. The CreateObject creates the stringbuilder. We chain the AppendFormat
' and the ToString methods to it, so actually these are three statements in one.
' Mind the HH in the HH:mm:ss format string, hh means 12 hour notation, HH means 24
' hour notation.
msgbox CreateObject("System.Text.StringBuilder").AppendFormat("{0:HH:mm:ss}", dt1).toString()
outputs 21:13:24
EDIT: Extra comments by request of TS
Is this what you are trying?
Option Explicit
Sub Sample()
Debug.Print Convert("23:61:61")
Debug.Print Convert("24:61:61")
Debug.Print Convert("20:72:84")
Debug.Print Convert("Hello World")
End Sub
Function Convert(strTime As String) As String
Dim timeArray() As String
Dim h As Long, m As Long, s As Long
On Error GoTo Whoa
timeArray = Split(strTime, ":")
h = timeArray(0): m = timeArray(1): s = timeArray(2)
Do Until s < 60
s = s - 60
m = m + 1
Loop
Do Until m < 60
m = m - 60
h = h + 1
Loop
Do Until h < 24
h = h - 24
Loop
Convert = Format(h, "00") & ":" & Format(m, "00") & ":" & Format(s, "00")
Exit Function
Whoa:
Convert = "Error! CYDD!" '<~~ CYDD : Check Your Data Dude :)
End Function
SNAPSHOT
EDIT (FOLLOWUP)
The code that I gave above is for VBA-Excel (as it is one of your tags)
For VB-Script, use this code
MsgBox Convert("23:61:61")
MsgBox Convert("24:61:61")
MsgBox Convert("20:72:84")
MsgBox Convert("Hello World")
Function Convert(strTime)
Dim timeArray
Dim h, m, s, hh, mm, ss
On Error Resume Next
timeArray = Split(strTime, ":", -1, 1)
h = timeArray(0): m = timeArray(1): s = timeArray(2)
If Err Then
Err.Clear
Exit Function
End If
Do Until s < 60
s = s - 60
m = m + 1
Loop
Do Until m < 60
m = m - 60
h = h + 1
Loop
' As per latest request
'Do Until h < 24
'h = h - 24
'Loop
If Len(Trim(h)) = 1 Then hh = "0" & h Else hh = h
If Len(Trim(m)) = 1 Then mm = "0" & m Else mm = m
If Len(Trim(s)) = 1 Then ss = "0" & s Else ss = s
Convert = hh & ":" & mm & ":" & ss
On Error GoTo 0
End Function
HTH
This seems to be quite obviously an "XY Problem": the OP is seeking a workaround to deal with a malformed piece of data, instead of figuring how the data is becoming malformed in the first place (and preventing it from happening).
20:72:84 is not a logical representation of duration by any standard, and whatever created that string is erroneous.
Technically, according to ISO-8601 (considered the "international standard for covering exchange of date and time related data"), duration should be expressed as PnYnMnDTnHnMnS.
That said, I would also opt for HH:MM:SS... but it should [obviously?] never show more than 59 seconds or 59 minutes, any more than our decimal (aka, Base 10) number system should count ...0.8, 0.9, 0.10, 0.11.... (lol, "zero point eleven")
Fixing the Duration
Regardless, it's an old question and we don't know how you got this strange number, but as others have suggested, I would use Split to fix it, although my preference is a more compressed form:
Function fixWonkyDuration(t As String) As String
fixWonkyDuration = Format(((Split(t, ":")(0) * 60 + Split(t, ":")(1)) _
* 60 + Split(t, ":")(2)) / 86400, "HH:mm:ss")
End Function
The function above will fix a "wonky" duration by converting each section into seconds, summing, then converting temporarily to a Date before using Format to display it as intended.
It's important to note that neither the input nor output is a valid Excel DateTime (Date), so both are declared as Strings.
Example Usage:
MsgBox fixWonkyDuration("20:72:84") 'returns "21:13:24"
Convert to Seconds (for comparison, calculations, etc)
Incidentally, when you have a valid duration in HH:MM:SS format, but want to do calculations or comparisons with it, it's easiest to first convert it to seconds with the help of TimeValue and CDbl.
The quickest method:
Function DurationToSeconds(d As String) As Long
DurationToSeconds = CDbl(TimeValue(d)) * 86400#
End Function
Example Usage:
MsgBox DurationToSeconds("21:13:24") 'returns 76404
Well, you can split into 3 variables: h,m and s. And then check if s>60. And if it is, m=m+s/60 and s=s%60. The same for the m variable:
if(m>60) then
h=h+m/60
m=m%60
Then, concate h, m and s.
This is too much text to put in a comment.
When you enter 20:72:33 into any cell that is on General format it will show you a serial number. E.g. 0.883715278
Then you change the cell format to Time. And it gives you the format and data you want to see.
HOWEVER,
The above statement only works as long as your seconds are below 60. If you enter 60, 61, 84, '100', etc. It doesn't work.
So perhaps you can jam it like all the jamming codes perhaps you are using right now. ;)
It's as ugly as it could get. Do mod 60 on seconds and then change cell format to Time. Or just as might as use what Alex shows up there in his answer. It's clean and gurantees your the desired output mathematically.
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