I am trying to write a function using Excel VBA to convert a string to its respective ASCII number. For example:
"ABCD" => "65666768"
I have written this code but it's failed to do the conversion:
Public Function asciien(s As String) As String
' Returns the string to its respective ascii numbers
Dim i As Integer
For i = 1 To Len(s)
asciien = asciien & CStr(Asc(Mid(s, x, 1)))
Next i
End Function
This line
asciien = asciien & CStr(Asc(Mid(s, x, 1)))
should read
asciien = asciien & CStr(Asc(Mid(s, i, 1)))
"x" has no value
Related
I know I can use Format() when converting a date into a string. And Cells.NumberFormat to change the display text of a date.
I'm trying to go the opposite direction. I have a string like "231211" or "08AUG11" and a corresponding date format like "YYMMDD" or "DDMMMYY" and I just need to convert the string based on the format. I already have a way to find the correct format of each string, I just need to do the conversion.
I can't seem to find the right function/method to do what I'm asking. DateTime.ParseExact doesn't seem to exist in Excel 2007, even after I added mscorlib.dll as a reference.
Is there an alternative I can use? Or how do I get DateTime.ParseExact to work properly in Excel 2007?
Since the string is not always the same length and there are about 30 different formats, it's quite annoying to conditionally split the string and interpret the substrings individually. I would love to be able to just parse the date based on the format.
here is a start to create your own function:
Function dateParser(str As String, fmt As String) As Date
If Len(str) <> Len(fmt) Then Exit Function
Dim dy As Long
Dim mnth As String
Dim yr As Long
Dim mnthnm As Long
Dim i As Long
For i = 1 To Len(str)
If UCase(Mid(fmt, i, 1)) = "D" Then
dy = dy * 10 + CLng(Mid(str, i, 1))
ElseIf UCase(Mid(fmt, i, 1)) = "Y" Then
yr = yr * 10 + CLng(Mid(str, i, 1))
ElseIf UCase(Mid(fmt, i, 1)) = "M" Then
mnth = mnth & Mid(str, i, 1)
End If
Next i
If IsNumeric(mnth) Then
mnthnm = CLng(mnth)
Else
mnthnm = Month(CDate("01 " & mnth & " 2020"))
End If
dateParser = DateSerial(yr, mnthnm, dy)
End Function
Used like:
Sub test()
Dim str As String
str = "08AUG11"
Dim fmt As String
fmt = "DDMMMYY"
Dim x As Date
x = dateParser(str, fmt)
debug.print x
End Sub
I have a access table and i am writing a vba code to remove non-ascii characters from the table, i have tried using below two functions
Public Function removeall(stringData As String) As String
Dim letter As Integer
Dim final As String
Dim i As Integer
For i = 1 To Len(stringData) 'loop thru each char in stringData
letter = Asc(Mid(stringData, i, 1)) 'find the char and assign asc value
Select Case letter 'Determine what type of char it is
Case Is < 91 And letter > 64 'is an upper case char
final = final & Chr(letter)
Case Is < 123 And letter > 96 'is an lower case char
final = final & Chr(letter)
Case Is = 32 'is a space
final = final & Chr(letter)
End Select
Next i
removeall = final
End Function
And also tried using below function
Public Function Clean(InString As String) As String
'-- Returns only printable characters from InString
Dim x As Integer
For x = 1 To Len(InString)
If Asc(Mid(InString, x, 1)) > 31 And Asc(Mid(InString, x, 1)) < 127 Then
Clean = Clean & Mid(InString, x, 1)
End If
Next x
End Function
But the problem is : In removeall function it removes everything including # and space characters.. And In Clean function also removes special characters as well.
I need a correct function which retains key board characters and removes all other characters
Examples of strings in tables are :
1) "ATTACHMENT FEEDING TUBE FITS 5-18 ºFR# "
2) "CATHETER FOLEY 3WAY SILI ELAST 20FR 30ML LATEXº"
Any help would be greatly appreciated
Output should be like
1) "ATTACHMENT FEEDING TUBE FITS 5-18 FR"
2) "CATHETER FOLEY 3WAY SILI ELAST 20FR 30ML LATEX"
One approach would be to use a whitelist of accepted characters. e.g.
' You can set up your domain specific list:
Const Whitelist = "1234567890" & _
"qwertyuiopasdfghjklzxcvbnm" & _
"QWERTYUIOPASDFGHJKLZXCVBNM" & _
" `~!##$%^&*()_-=+[]{};:""'|\<>?/ –"
Public Sub test()
Debug.Print Clean("ATTACHMENT FEEDING TUBE FITS 5-18 ºFR#")
Debug.Print Clean("CATHETER FOLEY 3WAY SILI ELAST 20FR 30ML LATEXº")
End Sub
Public Function isAllowed(char As String) As Boolean
isAllowed = InStr(1, Whitelist, char, vbBinaryCompare) > 0
End Function
Public Function Clean(dirty As String) As String
'-- Returns only printable characters from dirty
Dim x As Integer
Dim c As String
For x = 1 To Len(dirty)
c = Mid(dirty, x, 1)
If isAllowed(c) Then
Clean = Clean & c
End If
Next x
End Function
Alternate approach that preserves ALL ASCII characters, without working with a whitelist, in a single function:
Public Function RemoveNonASCII(str As String) As String
Dim i As Integer
For i = 1 To Len(str)
If AscW(Mid(str, i, 1)) < 127 Then 'It's an ASCII character
RemoveNonASCII = RemoveNonASCII & Mid(str, i, 1) 'Append it
End If
Next i
End Function
I have a VBA code that's designed to search a CSV String and add Carriage Returns where they should exist. I've split it up into two seperate functions - one to search the string and put the index of where the CRs should go into an array and a second function to actually add the CRs.
The issue I'm running into is that the value in the immediate window/in the watch window for the functions is correct within the function itself, but it assigns the result variable a blank string.
'*****************Import CSV**********************
'Took this straight off the internet because it was reading Jet.com files as one single line
'
Sub ImportCSVFile(filepath As String)
.....
line = SearchString(line, "SALE")
.....
End Sub
'****************Search String***************************
'This is search the string for something - It will then call a function to insert carriage returns
Function SearchString(source As String, target As String) As String
Dim i As Integer
Dim k As Integer
Dim myArray() As Variant
Dim resultString As String
Do
i = i + 1
If Mid(source, i, Len(target)) = target Then
ReDim Preserve myArray(k)
myArray(k) = i
k = k + 1
End If
DoEvents
Loop Until i = Len(source)
resultString = addCarriageReturns(source, myArray) 'resultString here is assigned a blank string
SearchString = resultString
End Function
'***************Add Carraige Returns**************************
'Cycle through the indices held in the array and place carriage returns into the string
Function addCarriageReturns(source As String, myArray As Variant) As String
Dim i As Integer
Dim resultString As String
resultString = source
For i = 0 To UBound(myArray, 1)
resultString = Left(resultString, myArray(i) + i) & Chr(13) & Right(resultString, Len(resultString) - myArray(i) + i)
Next i
addCarraigeReturns = resultString 'The value of addCarriageReturn is correct in the immediate window here
End Function
In the function the value is not blank
...but when it passes it back, it says the value is blank
I'm just curious, why do you want separate functions like this?
Can you just use:
line = Replace(line, "SALE", "SALE" & Chr(13))
I have a procedure, that generates a random string without any delimiter. I store return value of this as a string, but I would like to split this text into characters and after that examine each characters. I try to use above code to split string into characters, but it gives Type mismatch error.
Sub gen()
Dim s As String
s = textgen(4000, 5)
Dim buff() As String
ReDim buff(Len(s) - 1)
For i = 1 To Len(s)
buff(i - 1) = Mid$(s, i, 1)
Next
MsgBox (buff) ' type mismatch
End Sub
The type of buff is string() - an array of strings (VBA doesn't have a Char type).
MsgBox wants a String message, not an array of these; you'll have to Join the elements:
MsgBox Join(buff) 'no error
I'm working to create an Excel macro using VBA to convert bit strings to numbers. They are not binary numbers, each '1' stands for it's own number.
e.g: 1100000000000000000010001
from the left, the first bit represents "1", the second bit represents "2", third bit represents "0", and so on. The total quantity of bits in each string is 25.
I want VBA to convert it and show results like so: 1, 2, 21, 25.
I tried using Text to Columns but was not successful.
Try something like this:
Sub Execute()
Dim buff() As String
Dim i As Integer, total As Double
buff = Split(StrConv(<theString>, vbUnicode), Chr$(0))
total = 0
For i = 0 To UBound(buff)
Debug.Print (buff(i))
'total = total + buff(i) * ??
Next i
End Sub
Consider:
Public Function BitPicker(sIn As String) As String
For i = 1 To Len(sIn)
If Mid(sIn, i, 1) = 1 Then
BitPicker = BitPicker & i & ","
End If
Next
BitPicker = Mid(BitPicker, 1, Len(BitPicker) - 1)
End Function
Another non-VBA solution, based on the OP' initial approach and with a layout designed to facilitate multiple 'conversions' (ie copy formulae down to suit):
Does this have to be VBA? Give a data setup like this:
The formula in cell B4 and copied down to B33 is:
=IF(ROWS(B$3:B3)>LEN($B$1)-LEN(SUBSTITUTE($B$1,"1","")),"",FIND("#",SUBSTITUTE($B$1,"1","#",ROWS(B$3:B3))))
The formula cells are formatted as General and the the Bit String cell (B1) is formatted as Text.
Try this:
Function ConvertMyRange(Rng As Range) As String
Dim MyString As String
MyString = Rng.Text
Dim OutPutString As String
For i = 1 To Len(MyString)
If Mid(MyString, i, 1) = "1" Then OutPutString = OutPutString & ", " & i
Next i
' Get rid of first ", " that was added in the loop
If Len(OutPutString) > 0 Then
OutPutString = Mid(OutPutString, 2)
End If
ConvertMyRange = OutPutString
End Function
For your input, the output is 1, 2, 21, 25