This is an excel problem. I need to separate text and numbers in a string. The string can start with numbers or can start with characters. There could be spaces in between text or numbers. So the formula needs to be versatile enough to separate it into 2 columns with one column consisting of only text and the other only numbers. Please help.
Thank you very much
Examples of text strings
07 7878 8788 ABC JKSDKJK
ABCVG HDH 656688
AGSGD89789798798
798 99AJSUDFK
Only Text
Function Alphas(ByVal strInString As String) As String
Dim lngLen As Long, strOut As String
Dim i As Long, strTmp As String
lngLen = Len(strInString)
strOut = ""
For i = 1 To lngLen
strTmp = Left$(strInString, 1)
strInString = Right$(strInString, lngLen - i)
'The next statement will extract BOTH Lower and Upper case chars
If (Asc(strTmp) >= 65 And Asc(strTmp) <= 90 Or Asc(strTmp) >= 97 And Asc(strTmp) <= 122) Then
'to extract just lower case, use the limit 97 - 122
'to extract just upper case, use the limit 65 - 90
strOut = strOut & strTmp
End If
Next i
Alphas = strOut
End Function
Only Numbers
Function Numerics(ByVal strInString As String) As String
Dim lngLen As Long, strOut As String
Dim i As Long, strTmp As String
lngLen = Len(strInString)
strOut = ""
For i = 1 To lngLen
strTmp = Left$(strInString, 1)
strInString = Right$(strInString, lngLen - i)
If (Asc(strTmp) >= 48 And Asc(strTmp) <= 57) Then
strOut = strOut & strTmp
End If
Next i
Numerics = strOut
End Function
Only Number & Text
Function Alphanumerics(ByVal strInString As String) As String
Dim lngLen As Long, strOut As String
Dim i As Long, strTmp As String
lngLen = Len(strInString)
strOut = ""
For i = 1 To lngLen
strTmp = Left$(strInString, 1)
strInString = Right$(strInString, lngLen - i)
'The next statement will extract BOTH Lower and Upper case chars
If (Asc(strTmp) >= 65 And Asc(strTmp) <= 90 Or Asc(strTmp) >= 97 And Asc(strTmp) <= 122 or Asc(strTmp) >= 48 And Asc(strTmp) <= 57) Then
'to extract just lower case, use the limit 97 - 122
'to extract just upper case, use the limit 65 - 90
strOut = strOut & strTmp
End If
Next i
Alphanumerics = strOut
End Function
This can use in excel too but this is modified by me for Access use
As long as all your cells in column A are of the form {numbers + spaces}{non-numeric text} or the reverse, you can start by finding the positions of the first numeric character and the first non-numeric, non-space character in each cell. You could then use those plus a bit of extra logic to extract the appropriate substrings using MID.
I posted array formulas to do this here:
Excel formula to find the first non-alpha character in a cell?
You would need to make a slight modification to the second formula, so it returns the position of the first character that isn't a number or a space:
=MIN(
IF(
1*ISNUMBER(
1*MID(
A1,
ROW(INDIRECT("A1:A"&LEN(A1))),
1
)
) +
1*(MID(
A1,
ROW(INDIRECT("A1:A"&LEN(A1))),
1
)=" "),
LEN(A1)+1,
ROW(INDIRECT("A1:A"&LEN(A1)))
)
)
Related
I have created a VBA code to remove all special characters available in a column. As an example I have a Alphanumeric character with some special characters in every cells of a column:
Suppose in a cell I have a value: abc#123!-245
After executing my code I got output abc 123 245
Here my code is working fine to remove all the special characters. My code is given below:
Sub ReplaceSpecial()
Dim cel As Range
Dim strVal As String
Dim i As Long
Application.ScreenUpdating = False
For Each cel In Selection
strVal = cel.Value
For i = 1 To Len(strVal)
Select Case Asc(Mid(strVal, i, 1))
Case 32, 48 To 57, 65 To 90, 97 To 122
' Leave ordinary characters alone
Case Else
Mid(strVal, i, 1) = " "
End Select
Next i
cel.Value = strVal
Next cel
Application.ScreenUpdating = True
End Sub
Now if I want to remove the space for my output so that output should look like abc123245, how to do that in VBA?
Input: abc#123!-245
Current Output: abc 123 245
Required Output: abc123245
You could construct a new string with just the permitted characters.
Sub ReplaceSpecial()
Dim cel As Range
Dim strVal As String, temp As String
Dim i As Long
Application.ScreenUpdating = False
For Each cel In Selection
strVal = cel.Value
temp = vbNullString
For i = 1 To Len(strVal)
Select Case Asc(Mid(strVal, i, 1))
Case 32, 48 To 57, 65 To 90, 97 To 122
temp = temp & Mid(strVal, i, 1)
End Select
Next i
cel.Value = temp
Next cel
Application.ScreenUpdating = True
End Sub
My sole intention for this late post was to
test some features of the â–ºApplication.Match() function (comparing a string input against valid characters) and to
demonstrate a nice way to "split" a string into single characters as alternative and possibly instructive solution (see help function String2Arr()).
I don't intend, however to show better or faster code here.
Application.Match() allows not only to execute 1 character searches in an array, but to compare even two arrays in one go,
i.e. a character array (based on an atomized string input) against an array of valid characters (blanks, all digits and chars from A to Z).
As Application.Match is case insensitive, it suffices to take e.g. lower case characters.
All findings of input chars return their position in the valid characters array (otherwise resulting in Error 2042).
Furthermore it was necessary to exclude the wild cards "*" and "?", which would have been considered as findings otherwise.
Function ValidChars(ByVal s, Optional JoinResult As Boolean = True)
'Purp: return only valid characters if space,digits,"A-Z" or "a-z"
'compare all string characters against valid characters
Dim tmp: tmp = foundCharAt(s) ' get array with found positions in chars
'overwrite tmp array
Dim i As Long, ii As Long
For i = 1 To UBound(tmp)
If IsNumeric(tmp(i)) Then ' found in valid positions
If Not Mid(s, i, 1) Like "[?*]" Then ' exclude wild cards
ii = ii + 1
tmp(ii) = Mid(s, i, 1) ' get char from original string
End If
End If
Next
ReDim Preserve tmp(1 To ii) ' reduce to new size
'join tmp elements to resulting string (if argument JoinResult = True)
ValidChars = IIf(JoinResult, Join(tmp, ""), tmp)
End Function
Help function foundCharAt()
Returns an array of found character positions in the valid chars array:
Function foundCharAt(ByVal s As String) As Variant
'Purp: return array of found character positions in chars string
'Note: (non-findings show Error 2042; can be identified by IsError + Not IsNumeric)
Dim chars: chars = String2Arr(" 0123456789abcdefghijklmnopqrstuvwxyz")
foundCharAt = Application.Match(String2Arr(s), chars, 0)
End Function
Help function String2Arr()
Assigns an array of single characters after atomizing a string input:
Function String2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
s = StrConv(s, vbUnicode)
String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function
Use a regular expression's object and replace all unwanted characters by using a negated character class. For demonstration purposes:
Sub Test()
Dim str As String: str = "abc#123!-245"
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[^0-9A-Za-z ]"
str = .Replace(str, "")
End With
Debug.Print str
End Sub
The pattern [^0-9A-Za-z ] is a negated character class and captured everything that is not a alphanumeric or a space character. You'll find a more in-depth explaination in this online demo.
At time of writing I'm unsure if you want to leave out the space characters or not. If so, just remove the space from the pattern.
Thought I'd chuck in another alternative using the Like() operator:
For i = Len(str) To 1 Step -1
If Mid(str, i, 1) Like "[!0-9A-Za-z ]" Then
str= Application.Replace(str, i, 1, "")
End If
Next
Or with a 2nd string-type variable (as per #BigBen's answer):
For i = 1 to Len(str)
If Mid(str, i, 1) Like "[0-9A-Za-z ]" Then
temp = temp & Mid(str, i, 1)
End If
Next
If you want to build on your current effort, replace:
cel.Value = strVal
with:
cel.Value = Replace(strVal, " ", "")
Consider:
Sub ReplaceSpecial()
Dim cel As Range
Dim strVal As String
Dim i As Long
Application.ScreenUpdating = False
For Each cel In Selection
strVal = cel.Value
For i = 1 To Len(strVal)
Select Case Asc(Mid(strVal, i, 1))
Case 32, 48 To 57, 65 To 90, 97 To 122
' Leave ordinary characters alone
Case Else
Mid(strVal, i, 1) = " "
End Select
Next i
cel.Value = Replace(strVal, " ", "")
Next cel
Application.ScreenUpdating = True
End Sub
I have some code as shown below that i found on a forum , that will convert ASCII Code to Hexadecimal Characters using a VBA script, is it possible to convert Hex Characters to ASCII Characters ??
The code i have is as follows
Sub AsciiToHex()
Dim strg As String
Dim tmp As String
strg = Worksheets("Sheet1").Range("A1")
Worksheets("Sheet1").Range("A5").value = strg
tmp = ""
For i = 1 To Len(strg)
tmp = tmp & hex((Asc(Mid(strg, i, 1))))
Next
Worksheets("Sheet1").Range("A6").value = tmp
End Sub
I have tried to to swap the hex((Asc(Mid(strg, i, 1)))) to Asc((hex(Mid(strg, i, 1)))) but that did not work. Any help would be appreciated
Sample Data
Hex Format
48 65 6C 6C 6F
After conversion would be the following
Ascii Format
H e l l o
Hex To String
Function HexToString(InitialString As String) As String
Dim i As Long
For i = 1 To Len(InitialString) Step 2
HexToString = HexToString & Chr("&H" & (Mid(InitialString, i, 2)))
Next i
End Function
Function StringToHex(InitialString As String) As String
Dim i As Long
For i = 1 To Len(InitialString)
StringToHex = StringToHex & Hex(Asc(Mid(InitialString, i, 1)))
Next i
End Function
How about:
Public Function KonvertHex(s As String) As String
KonvertHex = ""
For i = 1 To Len(s)
KonvertHex = KonvertHex & Asc(Mid(s, i, 1))
Next i
End Function
This uses the worksheet function Hex2Dec.
[a1:e1] = [{"48", "65", "6C", "6C", "6F"}]
For Each c In Range("a1:e1")
c.Offset(1, 0) = Chr(WorksheetFunction.Hex2Dec(c))
Next c
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.hex2dec
Consider the following text string:
(*4,14)(7,15)(10,13)(9,12)-(1,8)(2,6)-5,3-11
My goal is to count how many left brackets ("("), commas outside brackets, and hyphens before each individual number in this string (e.g., 3 left brackets in front of the number 10, 6 left brackets and 3 hyphens in front of 11).
My current solution is to first recall the remaining text string in front of each individual number, simply =LEFT(A1,(FIND("1",A1,1)-1)), but it happens that Excel will recall the string appeared before the first "1" (i.e., (*4,), instead of recalling the remaining string from the actual number "1" in the string (i.e., (*4,14)(7,15)(10,13)(9,12)-().
Side note, any idea on how to count the number of commas that are outside of brackets?
Help would be much appreciate!
If you have a version of Excel with the FILTERXML function (Windows Excel 2013+), you can use:
=SUM(LEN(FILTERXML("<t>" & SUBSTITUTE(SUBSTITUTE(A1,"(","<s>"),")","</s>") & "</t>","//t")))- LEN(SUBSTITUTE(FILTERXML("<t>" & SUBSTITUTE(SUBSTITUTE(A1,"(","<s>"),")","</s>") & "</t>","//t"),",",""))
The formula creates an xml where the s nodes are what's included inside the parentheses, and the t node is everything else.
If you don't have the FILTERXML function, a VBA solution would be best. Which depends on your version of Excel, and whether it is Windows or MAC.
Count Chars
Option Explicit
Function countChars(SourceString As String, SourceNumber As Variant, _
CountChar As String, Optional countRight As Boolean = False) As Long
Dim NumberDouble As Double
Dim NumberString As String
Dim NumberLength As Long
Dim StringLength As Long
Dim CurrentStart As Long
Dim CurrentFound As Long
Dim i As Long
Dim isFound As Boolean
StringLength = Len(SourceString)
If VarType(SourceNumber) = 8 Then
If Not IsNumeric(SourceNumber) Then _
Exit Function ' SourceNumber is not numeric.
End If
NumberDouble = Val(SourceNumber)
If NumberDouble <> Int(NumberDouble) Then _
Exit Function ' SourceNumber is not an integer.
NumberString = CStr(NumberDouble)
NumberLength = Len(NumberString)
CurrentStart = 1
Do
CurrentFound = InStr(CurrentStart, SourceString, NumberString)
GoSub checkNumber
If isFound Then
GoSub countTheChars
Exit Do
End If
CurrentStart = CurrentFound + 1
Loop Until CurrentFound = 0
Exit Function
countTheChars: ' Can be written better.
If Not countRight Then
For i = 1 To CurrentFound - 1
If Mid(SourceString, i, 1) = CountChar Then
countChars = countChars + 1
End If
Next i
Else
For i = CurrentFound + 1 To StringLength
If Mid(SourceString, i, 1) = CountChar Then
countChars = countChars + 1
End If
Next i
End If
checkNumber: ' Check for adjacent numbers.
Select Case CurrentFound
Case 0: Exit Function ' NumberString (initially) not found.
Case 1 ' NumberString found at the beginning.
isFound = Not _
IsNumeric(Mid(SourceString, CurrentFound + NumberLength, 1))
Case StringLength - NumberLength + 1 ' NumberString found at the end.
isFound = Not _
IsNumeric(Mid(SourceString, CurrentFound - 1, 1))
Case Else ' NumberString found in the middle.
isFound = Not _
IsNumeric(Mid(SourceString, CurrentFound + NumberLength, 1)) _
And Not IsNumeric(Mid(SourceString, CurrentFound - 1, 1))
End Select
Return
End Function
I've the following Excel data:
A B C
+ ------------ ------------- -----------------
1 | WORD WORD MIX MATCH TEXT RESULT
2 | somewordsome emsomordsowe ...
3 | anotherword somethingelse ...
4 | ... ... ...
I'd like to:
Firstly, get an array, say ArrayOfGroups, by splitting the string in the A2 cell in unique groups of 2 to 12 adjacent chars (note: 2 is the minimum number of chars to form a group; 12 is the total number of the word's chars) i.e. the groups of 2 chars would be so, om, me, ew, wo, or, rd, ds (note: the last so, om and me groups are excluded because they are repeated); the groups of 3 chars would be som, ome, mew, ewo, wor, ord, rds, dso (last som and ome excluded); the groups of 4 chars would be some, omew, mewo, ewor, word, ords, rdso, dsom; ... and so on until the full string somewordsome.
Then, iterate the above-mentioned ArrayOfGroups to check if each of its element is a substring of the B2 cell and return a new array, say ArrayOfMatches, containing all the elements (the characters "group names") that are substrings of B2 and the number of occurrences found in B2.
Finally, output in the C2 cell a sentence built using the ArrayOfMatches data that says something like this:
2 matches for so, 1 match for som and rd
Probably there are other and better approaches to compute the above sentence that is the final result wanted. Maybe I need to use a User Defined Function... but I never made it.
Is there someone that could give help?
May try something like this
Code edited to avoid counting for same substring found multiple times.
Sub test2()
Dim Xstr As String, Ystr As String
Xstr = "somewordsome"
Ystr = "emsomordsowe"
MsgBox Xmatch2(Xstr, Ystr)
End Sub
Function Xmatch2(Xstr As String, Ystr As String) As String
Dim XSubStr As String, YSubStr As String
Dim xLn As Integer, yLn As Integer
Dim XArr As Variant, LnSubStr As Integer
Dim Rslt As String, Cnt As Integer
Dim Xrr() As Variant, Xcnt As Integer, Chk As Boolean
Rslt = "'"
xLn = Len(Xstr)
yLn = Len(Ystr)
For LnSubStr = 2 To xLn 'length of substring
Xcnt = 0
ReDim XArr(1 To 1)
For Y = 1 To xLn
XSubStr = ""
Xcnt = Xcnt + 1
ReDim Preserve XArr(1 To Xcnt)
If Y + LnSubStr - 1 <= xLn Then XSubStr = Mid(Xstr, Y, LnSubStr)
XArr(Xcnt) = XSubStr
Chk = False
For i = 1 To Xcnt - 1
If XArr(i) = XSubStr Then
Chk = True
Exit For
End If
Next
If XSubStr <> "" And Chk = False Then
Cnt = 0
ReDim Preserve XArr(1 To Xcnt)
For Z = 1 To yLn
YSubStr = ""
If Z + LnSubStr - 1 <= yLn Then YSubStr = Mid(Ystr, Z, LnSubStr)
If YSubStr = XSubStr Then Cnt = Cnt + 1
Next
If Cnt > 0 Then Rslt = Rslt & Cnt & " Matches for " & XSubStr & ","
End If
Next
Next
Debug.Print Rslt
Xmatch2 = Rslt
End Function
hi i have this problem finding a string on a text box
so far this what i have it only detect the comma char, now i i input 23pm,24,25am how will i do this with this code or anybody can give me the simple code?
Dim tdates() As String
Dim numberOfDates, xcount As Integer
tdates = Split(TXTDAYS.Text, ",")
numberOfDates = UBound(tdates)
Dim counter As Integer
' loop through each input
For counter = 0 To numberOfDates
Dim xdate As String
xdate = LCase$(tdates(counter))
If Len(xdate) <= 2 Then
xcount = xcount + 1
Else
' if the original text has am or pm in it, add .5
If InStr(1, xdate, "am") > 0 Or InStr(1, xdate, "pm") > 0 Then
xcount = xcount + 0.5 'problem here it doesn't count
End If
End If
Next
if there is a better way to do this by detecting the comma and the am pm string much better.
Split the text on comma. Then your array will have all of the whole words in it
Use InStr to search for am or pm.
Replace AM and PM with "" and check the remainder of the text for a number (for validating)
' split the input on a comma.
dim dates() as String = Split(TXTDAYS.Text, ",")
dim numberOfDates as Integer = UBound(dates)
dim counter as Integer
' loop through each input
For counter = 0 to numberOfDates
dim dateEntered as String = LCase$(dates(counter))
' make sure the text entered is a number (once am and pm are removed)
dim dateNumber as String = Replace(Replace(dateEntered, "pm", ""), "am", "")
if IsNumeric(dateNumber) Then
COUNT = COUNT + 1
' if the original text has am or pm in it, add .5
if Instr(1, dateEntered , "am") > 0 Or Instr(1, dateEntered , "pm") > 0 Then
COUNT = COUNT + .5
end if
else
' do something to indicate invalid input
end if
Next
using instr()..
s = "admin#foo.com"
d = Mid(s, InStr(1, s, "#") + 1)
The variable d$ would end up with the string "foo.com". (Don't forget to check to make sure that the # sign is present, otherwise you would just end up with the whole source string.)
taken from this post..
VB6 Index of Substring
Thanks!
#leo