Quick question, if I want to delete everything after the second occurrence of a number:
i.e -
I have:
1105 Bracket Ave. Suite 531 Touche
5201 Used St. 1351 Bored Today
I want:
1105 Bracket Ave. Suite 531
5201 Used St. 1351
is there a simple formula or VBA I would use for this?
Here is a UDF using VBA's regular expression engine to remove all after the second integer.
Option Explicit
Function FirstTwoNumbers(S As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "(\d+\D+\d+).*"
FirstTwoNumbers = .Replace(S, "$1")
End With
End Function
If there is only a single integer, it will return the entire string.
If the numbers might be decimal numbers, will need to modify .Pattern
And here is another UDF using only native VBA methods:
Function FirstTwo(S As String) As String
Dim V
Dim tS As String
Dim I As Long, numNumbers As Long
V = Split(S)
Do Until numNumbers = 2
tS = tS & Space(1) & V(I)
I = I + 1
If IsNumeric(V(I - 1)) Then numNumbers = numNumbers + 1
Loop
FirstTwo = Mid(tS, 2)
End Function
and finally, a formula with no particular assumptions:
=LEFT(A1,FIND(CHAR(1),SUBSTITUTE(A1," ",CHAR(1),LOOKUP(2,1/ISNUMBER(-TRIM(MID(SUBSTITUTE(A1," ",REPT(" ",99)),seq_99,99))),seq))))
seq and seq99 are Named Formulas Formula ► Define Name
seq Refers to: =ROW(INDEX($1:$255,1,1):INDEX($1:$255,255,1))
seq_99 Refers to: =IF(ROW(INDEX($1:$255,1,1):INDEX($1:$255,255,1))=1,1,(ROW(INDEX($1:$255,1,1):INDEX($1:$255,255,1))-1)*99)
This solution is with these assumptions:-
First occurrence of a number will not have a length > 10
There will atleast a distance of 10 or 10 alphabets including spaces between first and second number
There will always be a 'space' existing after second number
There will always be a second number present in the string
Try this:-
=TRIM(MID(A1,1,FIND(" ",A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A1&"0123456789",MIN(FIND({0,1,2,3,4,5,6,7,8,9},A1&"0123456789"))+10)))))
Here is a VBA approach, amend range to suit. It puts the answer in the adjacent column
Sub x()
Dim oMatches As Object, r As Range
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\d+"
For Each r In Range("A1:A5")
If .Test(r) Then
Set oMatches = .Execute(r)
If oMatches.Count > 1 Then
r.Offset(, 1).Value = Left(r, oMatches(1).firstindex + oMatches(1).Length)
Else
r.Offset(, 1).Value = r.Value
End If
Else
r.Offset(, 1).Value = r.Value
End If
Next r
End With
End Sub
You can use the following formula,if A1 is your string,in B1 write:
=LEFT(A1,MAX(IFERROR(ISNUMBER(VALUE(MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)))*ROW(INDIRECT("1:"&LEN(A1))),0)))
press Ctrl+Shift+Enter at the same time Array Formula
This will read the length of the string and return the Maximum place of numbers (last number in the string) and return the Left() string till this number
Related
Through my work, and copying others, I have cobbled together a Excel VBA Sub that separates a long sting with groups of (text groups) and (number groups) into a replacement string with spaces in between each seperate group; as per this example:
• “123abc12aedsw2345der”
• …Apply selection Sub() then becomes:
• “123 abc 12 aedsw 2345 der”
It converts the string in its original cell as per the “selection”, so I am currently left with the altered data in is original cell
PROBLEM: I would like to change this into a FUNCTION where the transformed data would appear in the Function cell and leave the original cell intact. I have done hundreds of these but I cannot seem to get this to work as an independent FUNCTION. Below the finished and working Sub Routine I am trying to convert to an independent function to call from anywhere on the worksheet:
Sub SplitTextNumbersSelection()
Dim c As Range
'********** Inserts Space Before Number Groups ******************************
For n = 1 To 10
For Each c In Selection
c = InsertSpace(c.Text)
Next
Next n
'****************Inserts Space Before Letter Groups ***********************
For n = 1 To 10
For Each c In Selection
c = InsertSpace2(c.Text)
Next
Next n
'****************************************
End Sub
Function InsertSpace(str As String) As String
With CreateObject("vbscript.regexp")
.Pattern = "([a-z])(\d)"
'.Pattern = "(\d)([a-z])"
InsertSpace = .Replace(str, "$1 $2")
End With
End Function
Function InsertSpace2(str As String) As String
With CreateObject("vbscript.regexp")
'.Pattern = "([a-z])(\d)"
.Pattern = "(\d)([a-z])"
InsertSpace2 = .Replace(str, "$1 $2")
End With
End Function
Bit simpler:
Function PrepString(v As String)
Dim rv As String, i As Long, c1, c2
For i = 1 To Len(v) - 1
c1 = Mid(v, i, 1)
c2 = Mid(v, i + 1, 1)
If (c1 Like "[a-z]" And c2 Like "[0-9]") Or _
(c2 Like "[a-z]" And c1 Like "[0-9]") Then
rv = rv & c1 & " "
Else
rv = rv & c1
End If
Next i
PrepString = rv & Right(v, 1)
End Function
lets say
In a range A1
8cm book + 13cm ruler + 0.34cm paper
then how i sum up 8 + 13 + 0.34 inside the cell then = 21.34cm
then put the sumup in A2
——————-updates question———————
Sorry, I must make the question clearer!
8cm book + 13cm ruler + ruler version#2 +0.34cm paper
And I was wondering is it still working for the code from all master?
this problem bothers me 1 week.
hope can get the anwser!
thanks!!
Try this simple regex based UDF.
Option Explicit
Function sumNums(str As String) As Double
Dim n As Long
Static rgx As Object, cmat As Object
If rgx Is Nothing Then
Set rgx = CreateObject("VBScript.RegExp")
End If
With rgx
.Global = True
.MultiLine = True
.Pattern = "(\-?\d*\.?\d+)"
If .test(str) Then
Set cmat = .Execute(str)
For n = 0 To cmat.Count - 1
sumNums = sumNums + CDbl(cmat.Item(n))
Next n
End If
End With
End Function
Here is a User Defined Function, just using String indexing:
Function SumNumbers(s As String) As Currency
Dim i As Long
Dim j As Long
For i = 1 To Len(s)
If InStr("-0123456789.", Mid(s, i, 1)) Then
j = i
Do
i = i + 1
Loop While InStr("0123456789.", Mid(s, i, 1))
SumNumbers = SumNumbers + CCur(Mid(s, j, i - j))
End If
Next
End Function
Put it in the Visual Basic Editor (Shift+F11) in a new Module (right-click project, choose "Insert..." and "Module").
Use the formula in your sheet, for example in cell B1:
=SumNumbers(A1)
NB: I prefer to use Currency and CCur to avoid floating point errors. It expects numbers to have at the most 4 decimals, and supports up to about 14 digits before the decimal separator.
another solution is:
Function cal_cm(cl As Range) As Double
Dim i%, testVal$, result$
result = "="
For i = 1 To Len(cl)
testVal = cl.Characters(i, 1).Text
If "0123456789+." Like "*" & testVal & "*" Then
result = result & testVal
End If
Next i
cal_cm = Evaluate(result)
End Function
test
Here is a way to do it without VBA, but with some limitations:
It expects every number to be followed by "cm"
It expects every number to have a space in front of it (except for the first number which may be at the very start of the string)
You need to know what the maximum count of numbers is in the input
Assuming the input string is in cell A1, you could proceed as follows:
Leave B1 blank
In C1 put the formula =IFERROR(MID($A1,1,FIND("cm",$A1,LEN(B1)+2)-1), "0")
Copy C1 to D1, E1, and F1
In G1 put the formula =VALUE(IFERROR(RIGHT(C1,LEN(C1)-FIND("#",SUBSTITUTE(C1," ","#",LEN(C1)-LEN(SUBSTITUTE(C1," ",""))),1)),C1))
Copy G1 to H1, I1, and J1
In K1 put the formula =SUM(G1:J1)
You would get this result. The color coding identifies each of the groups that are copies:
K1 will have the desired output.
Note that F1 (and J1) contain 0. This would get the value of a fourth value in the input if it existed.
You'll understand how to make room for more cells if your input could have 5 or more numerical values embedded in it.
I'm trying to create this tool that will, by looking through a list of expenses, be able to calculate the amount owed to each employee. So from our account software I can export an excel document with 2 columns. The first column have the amount and the second will have the following strings:
"Lunch, outlay Tanne"
"Train ticket, outlay Anne"
"Lunch, outlay Dennis"
"Lunch, outlay Anne"
The excel document will then look through all the expenses and calculate the total amount owed to each person. So far I've used the following code to calculate the total amounts (some of the variables are calculated earlier, this is just the part calculating the total amount):
'Calcualte total amount
For i = 1 To NamesTotal
TotalAmount = 0
NameString = UCase(Cells(i + 1, 7))
For j = 1 To EntriesTotal
CellText = UCase(Cells(j + 2, 3))
If InStr(1, CellText, NameString) Then
Amount = Cells(j + 2, 4)
TotalAmount = TotalAmount + Amount
End If
End If
Next
Cells(TableStart + i, 3) = Cells(i + 1, 7)
Cells(TableStart + i, 4) = TotalAmount
Cells(TableStart + i, 4).NumberFormat = "#,##0.00"
Next
The list of names is listed in column 7, the strings in column 3 and amount in column 4. The list works fine (I have a little more code) but the problem lies with names very similar to each other
If InStr(1, CellText, NameString) Then
In my example above the name "Anne" is part of the name "Tanne" so the list for Tanne will include the expenses for Anne as well. So how do I change the code so that it will find the exact match?
You could write a regex function that looks for the name as a word using word boundary syntax i.e. \bName\b
In my example the arguments to the function equate to CellText, NameString
Try it here.
Option Explicit
Public Sub TEST()
Dim rng As Range
For Each rng In [A1:A4]
If IsNamePresent(rng.Value, "Anne") Then
'do something
End If
Next
End Sub
Public Function IsNamePresent(ByVal inputString As String, testName As String)
IsNamePresent = False
With CreateObject("vbscript.regexp")
.Global = True
.MultiLine = True
.IgnoreCase = False '<== You may want to change this
.Pattern = "\b" & testName & "\b"
If .TEST(inputString) Then IsNamePresent = True
End With
End Function
Test values:
Regex:
\bAnne\b
/
gm
\b assert position at a word boundary (^\w|\w$|\W\w|\w\W)
Anne matches the characters Anne literally (case sensitive)
\b assert position at a word boundary (^\w|\w$|\W\w|\w\W).
So, must be Anne as a word and not Anne as part of a longer string.
one of the possible solutions (the way to achieve required result):
Function getval(searchStr As String, rng As Range) As String
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
Dim cl As Range, wrd
For Each cl In rng
For Each wrd In Split(Replace(cl.Value2, ",", ""))
If LCase(wrd) = LCase(searchStr) Then dic.Add cl.Value2, ""
Next wrd, cl
getval = Join(dic.keys, vbNewLine)
End Function
test
I'm facing a problem as a non dev. I have a column in Excel that contains info as such:
46843 xxxx xxx x
xxxx 65483 xxxx
xxxx xxx 65432 xxxxx 4 xx
"x" being normal caracters.
What I want is to be able to extract only the numbers of five digits only.
I started something like this but struggle to put a loop so that it scans all the string:
Function test()
val_in = "rue 4 qsdqsd CURIE 38320 EYBENS"
Filte = Left(val_in, 5)
If IsNumeric(Filte) Then
test = Left(val_in, 5)
Else
sp1 = InStr(1, val_in, " ")
sp2 = InStr(sp1 + 1, val_in, " ")
spt = sp2 + sp1
If spt > 5 Then
extr = Mid(val_in, spt, 5)
End If
End If
End Function
How could I turn the part after "Else" into a loop so that it would scan every space of the string and extract only the numbers that contains 5 digits?
Using regex
Option Explicit
Public Function GetNumbers(ByVal rng As Range) As Variant
Dim arr() As String, i As Long, matches As Object, re As Object
Set re = CreateObject("VBScript.RegExp")
With re
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "\b\d{5}\b"
If .test(rng.Value) Then
Set matches = .Execute(rng.Value)
ReDim arr(0 To matches.Count - 1)
For i = LBound(arr) To UBound(arr)
arr(i) = matches(i)
Next i
Else
arr(i) = rng.Value
End If
End With
GetNumbers = Join(arr, ",")
End Function
Data:
If there is more than one match a comma separated list is returned.
Sub TestMe()
Dim valIn As String
valIn = "rue 4 qsdqsd CURIE 38320 EYBENS 43443"
Dim i As Long
Dim splitted As Variant
splitted = Split(valIn)
For i = LBound(splitted) To UBound(splitted)
If IsNumeric(splitted(i)) And Len(splitted(i)) = 5 Then
Debug.Print splitted(i)
End If
Next i
End Sub
Considering that in your example you mean that the 5 digit numbers are splitted by space, the above works. It splits the string by space to an array and loops through the elements of the array. If the element is with 5 chars and is numeric, it prints it.
If the rule for the spaces is not something that one can count on, here is a different implementation:
Sub TestMe()
Dim valIn As String
valIn = "44244rue4qsdqsdCURIE383201EYBENS43443"
Dim i As Long
For i = 1 To Len(valIn) - 4
If IsNumeric(Mid(valIn, i, 5)) Then
Debug.Print Mid(valIn, i, 5)
End If
Next i
End Sub
It starts looping through the string, checking whether each 5 chars are numeric. When you have numeric 6 chars, it gives two results - 1 to 5 and 2 to 6. Thus 383201 is "translated" as the following 2:
38320
83201
If you have always space between words/numbers then this should do
Sub test()
Dim TestStr As String
Dim Temp As Variant
Dim i As Long, FoundVal As Long
TestStr = "rue 4 qsdqsd CURIE 38320 EYBENS"
Temp = Split(TestStr, " ")
For i = 0 To UBound(Temp)
If Len(Trim(Temp(i))) = 5 And IsNumeric(Temp(i)) Then
FoundVal = Temp(i)
MsgBox FoundVal
End If
Next i
End Sub
From the solution you are trying to apply (creating custom function in VBA) I understand that you actually need to use it in a formula.
To find number with five digits from cell A1 you can use the following formula without VBA:
=IF(ISERROR(FIND("0"&REPT("1",5)&"0",CONCAT(0+(ISNUMBER(-MID(" "&A1&" ",ROW(INDIRECT("1:"&LEN(A1)+2)),1))+0)))),"",MID(A1,FIND("0"&REPT("1",5)&"0",CONCAT(0+(ISNUMBER(-MID(" "&A1&" ",ROW(INDIRECT("1:"&LEN(A1)+2)),1))+0))),5))
To search for other number of digits change the three occurrences of number 5 to your desired digits count in the formula.
I am new at excel VB and seek assistant in the following problem below:
I have a column A with following values below:
column A
"VL50s"
"M50s"
"H50s"
"VL50s"
"H50s"
I would like to extract the numbers and run the following arithmetic function below into coloumn B.
key:
x is a number
VLx --> (x) + 1
Mx -->(x) + 2
Hx --> (x) + 3
the output should look like the following using the key above:
coloumn B
51
52
53
51
53
I would like to ask how would i go about doing this function in VBA. Thank you for your assistance.
Because you say the number of letter/number combos is much greater than in your example I think this is a problem for VBA and not a worksheet function. A WS function would become to hard to maintain and to beastly very quickly.
I made these 4 functions. The GetCharArray function parses the text of the string you pass it to return that text as an array of characters (even though BA doesn't have a char type just a string type so I am returning a string. Same idea)
Then given that we can call GetNumberFromChars to get the 50 from VL50s and call GetLeftMostLetters to get the VL from VL50s.
Then is some worksheet I made a named range called keys where column 1 of the range is letters like "VL", "H", "M" ... and the corresponding value associated with it is in column 2. It would look like
Col1 Col2
VL 1
M 2
H 3
... ...
We can use the vlookup worksheet function with the Range("keys") and the result of GetLeftMostLetters to find the number that should be added to the result of GetNumberFromChars.
Function GetNewNumber(inString As String) As Double
Dim searchString As String, numberToAddFromKeys As Double, numberToAddToFromCell As Long, cellChars() As String
cellChars = GetCharArray(inString)
searchString = GetLeftMostLetters(cellChars)
numberToAddToFromCell = GetNumberFromChars(cellChars)
'use the keys named range where column 1 is your letters ("VL","H"...)
'and column 2 is the corresponding value for that letter set
numberToAddFromKeys = WorksheetFunction.VLookup(searchString, Range("keys"), 2, 0)
GetNewNumber = CDbl(numberToAddFromKeys) + CDbl(numberToAddToFromCell)
End Function
Function GetNumberFromChars(inChars() As String) As Long
Dim returnNumber As String, i As Long, numberStarted As Boolean
For i = 1 To UBound(inChars)
If IsNumeric(inChars(i)) Then
If Not numberStarted Then numberStarted = True
returnNumber = returnNumber & inChars(i)
Else
If numberStarted Then
'this will ignore that "s" on the end of your sample data
'hopefully that's what you need
GetNumberFromChars = returnNumber
Exit Function
End If
End If
Next
End Function
Function GetLeftMostLetters(inChars() As String) As String
Dim returnString As String, i As Long
For i = 1 To UBound(inChars)
If Not IsNumeric(inChars(i)) Then
returnString = returnString & inChars(i)
Else
GetLeftMostLetters = returnString
End If
Next
End Function
Function GetCharArray(inText As String) As String()
Dim s() As String, i As Long
ReDim s(1 To Len(inText))
For i = 1 To UBound(s)
s(i) = Mid$(inText, i, 1)
Next
GetCharArray = s
End Function
So it can be used as such...
Dim cell As Range, rng As Range
'set this range to your actual range.
Set rng = Sheets("your sheet name").Range("A1:A5")
For Each cell In rng
'put this resulting value wherever you want.
Debug.Print GetNewNumber(cell.Value)
Next cell
You don't even have to use VBA for that, you can use a (very ugly) formula to determine this:
=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1, "VL",""), "M",""), "H", ""),
"s", "") + IF(LEFT(A1, 2) = "VL", 1, IF(LEFT(A1, 1) = "M", 2,
IF(LEFT(A1,1) = "H", 3, 0)))
In reality this formula should be on one line, but I've broken it up here so that it's readable. Place the formula in cell B1, and then copy it down to any other cells you need. It strips out all instances of "VL", "M", "H" and "s", and then adds the extra number based on the left 1 or 2 characters of the A cell.
This will return the first number found in the input value:
Function GetNumber(val)
Dim re As Object
Dim allMatches
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "(\d+)"
re.ignorecase = True
re.Global = True
Set allMatches = re.Execute(val)
If allMatches.Count > 0 Then
GetNumber = allMatches(0)
Else
GetNumber = ""
End If
End Function
EDIT: just noticed your question title says "decimal" numbers - will your values have any decimal places, or all they all whole numbers?