I have a column (E) of items that are filled with codes that resemble the following format: 5301-500-300-000
with an adjacent column (F) of 'amounts paid' that look like the following: 53.20
My goal is to multiply the appropriate amounts in column F with the right tax rebates by using a nested if formula in vba. I've managed to do this using excel functions as follows:
a left(E2,4) formula
& a mid(E2,10,2) formula followed by a
=IF(OR(F282=1151,F282=1153),IF(OR(G282=131,G282=200,G282=210,G282=300,G282=310,G282=320,G282=800,G282=821,G282=831,G282=841,,G282=700,G282=721),H282*0.5,IF(OR(G282=341,G282=351,G282=400,G282=410,G282=421,G282=431,G282=441,G282=500,G282=511,G282=521,G282=531,G282=600,G282=611,G282=900,G282=700,G282=721),H282*0.3031,0))) formula
My question is how could I convert this series of excel formulas into a vba format so that I wouldn't have to constantly use the LEFT & MID excel functions.
So far, I've tried creating variables for left' &mid `
Private Sub CommandButton2_Click()
Dim taxcode As Range, location As Range
Set taxcode = Left(Range("E2:E10000"), 4)
Set location = Mid(Range("E2:E10000"), 10, 2)
End Sub
But have already seen problems with my code. Any help would be most appreciated.
I would use a regular expression for this sort of thing; that way you can avoid having those awfull nested LEFT() and MID() stuff.
So, let's get to it.
First, in the VBA editor, clic on the Tools menu and select References; enable Microsoft VBScript Regular Expressions 5.5.
Then, let's use a RegEx to split each entry from your string:
Function splitCode(code As String) As String()
Dim ans(1 To 4) As String
Dim re As RegExp
Set re = New RegExp
With re
.IgnoreCase = True
.MultiLine = False
.Pattern = "([0-9]*)-([0-9]*)-([0-9]*)-([0-9]*)"
' Here's the magic:
' [0-9]* will match any sequence of digits
' The parenthesis will help you retreive each piece of the pattern
End With
If re.Test(code) Then
ans(1) = re.Replace(code, "$1") ' You can use the Replace method to get
ans(2) = re.Replace(code, "$2") ' each piece of the pattern.
ans(3) = re.Replace(code, "$3") ' Simply use $n (where n is an integer)
ans(4) = re.Replace(code, "$4") ' to get the n-th piece of the pattern enclosed in parenthesis
End If
Set re = Nothing
splitCode = ans
End Function
Now that you have this array with each piece of your code, you can use it in other sub or function to get what you need:
sub doMyStuff()
dim taxCodeRange as Range, taxCode as String()
dim i as integer
taxCodeRange = Range("E2:E1000")
for i = 1 to taxCodeRange.Rows.count
taxCode = splitCode(taxCodeRange.Cells(i,1))
' Now you can make whatever comparissons you need with each entry
' of the taxCode array.
' WARNING: Each entry in the array is a String, so you may want
' to convert it to integer before doing any comparissons
if CInt(taxCode(1)) = 5301 then
' Do some stuff
elseIf cInt(taxCode(1)) = 5302 then
' Do some other stuff
' ...
' ...
' end if
next i
end sub
Hope this helps you.
Take a look to this post for more information about Regular Expressions in Excel
Related
I'm trying to extract 'manufacturer=acme' from, for example:
attribute1=red,attribute2=medium,manufacturer=acme,attribute4=spherical
from column 'attributes', for which there are 8000+ rows.
I can't use left(), right(), split() functions because the manufacturer attribute doesn't have a fixed number of attributes/characters to the left or right of it and split() only works for one character, not a string.
Is there a way I can achieve this, target the string manufacturer= and remove all text from the left and right starting from its encapsulating commas?
Quick mock-up for looping through a split string (untested):
dim stringToArray as variant: stringToArray = split(target.value, ",")
dim arrayItem as long
for arrayLocation = lbound(stringToArray) to ubound(stringToArray)
if instr(ucase(stringToArray(arrayLocation)), ucase("manufacturer=")) then
dim manufacturerName as string: manufacturerName = right(stringToArray(arrayLocation), len(stringToArray(arrayLocation))-len("manufacturer="))
exit for
end if
next arrayLocation
debug.print manufacturerName
I have, maybe, an overkill solution using RegExp.
Following is a UDF you can use in a formula
Public Function ExtractManufacturerRE(ByRef r As Range) As String
On Error GoTo RETURN_EMPTY_STR
Dim matches As Object
With CreateObject("VBScript.RegExp")
.Pattern = "manufacturer=[^,]+"
.Global = False
Set matches = .Execute(r.Value)
If matches.Count > 0 Then
ExtractManufacturerRE = matches.Item(0).Value
End If
End With
RETURN_EMPTY_STR:
End Function
To be fair, this is sub-optimal, plus it doesn't work on a range but only on a single cell.
I need to remove the numeric characters that are separated by white space ONLY in a text string in an Excel cell. For example I have:
johndoe99#mail.com 1 concentr8 on work VARIABLE1 99
I need to get:
johndoe99#mail.com concentr8 on work VARIABLE1
Either formula or VBA script solution is good. Thank you.
I think nomad is right that regex is probably a simpler option. However, I also think that by using the Split() and isNumeric() functions I've come up with a good solution here.
Sub test()
Dim cell As Range
For Each cell In Range("A1:A10") 'adjust as necessary
cell.Value2 = RemoveNumbers(cell.Value2)
Next cell
End Sub
Function RemoveNumbers(ByVal inputString As String) As String
Dim tempSplit As Variant
tempSplit = Split(inputString, " ")
Dim result As String
Dim i As Long
For i = LBound(tempSplit) To UBound(tempSplit)
If Not IsNumeric(tempSplit(i)) Then result = result & " " & tempSplit(i)
Next i
RemoveNumbers = Trim$(result)
End Function
UDF
Function RemNum(cell)
With CreateObject("VBScript.RegExp")
.Global = True: .Pattern = "\s\d+"
RemNum = .Replace(cell, vbNullString)
End With
End Function
Note that in addition to testing for spaces before and after, this also tests for the beginning or end of the string as a delimiter.
You did not indicate the case where the number is the only contents of the string. This routine will remove it but, if you want something else, specify.
Try this:
Function remSepNums(S As String) As String
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "(?:\s+|^)(?:\d+)(?=\s+|$)"
.MultiLine = True
remSepNums = .Replace(S, "")
End With
End Function
Just for fun, if you have a recent version of Excel (Office 365/2016) you can use the following array formula:
=TEXTJOIN(" ",TRUE,IF(NOT(ISNUMBER(FILTERXML("<t><s>"&SUBSTITUTE(TRIM(A1)," ","</s><s>")&"</s></t>","//s"))),FILTERXML("<t><s>"&SUBSTITUTE(TRIM(A1)," ","</s><s>")&"</s></t>","//s"),""))
FILTERXML can be used to split the string into an array of words, separated by spaces
If any word is not a number, return that word, else return a null string
Then join the segments using the TEXTJOIN function.
I am trying to cleanup a set of strings in Excel to extract certain words after removing some prefixes and extra characters. Initially I was trying this with FIND, LEFT, MID, etc. Then, I came across this helpful post and trying my hand at regex.
https://superuser.com/questions/794536/excel-formulas-for-stripping-out-prefix-suffix-around-number
I have used the UDF given there called Remove which takes a regex argument. Now, I am still not able to remove all the items I wanted to remove.
In the attached Excel you can see what I have tried and what the answer I am looking.
Here are the Prefixes I wanted to remove:
The numbers in the beginning surrounded by brackets - Ideally I want this in a separate column.
Anyword before a hyphen here there are a number of them 'l-', 'al-'
and then these prefixes below.
bi
bil
fa
wa
wal
How do I write a single regex which would remove all the above prefixes?
Here is the UDF I am using:
Function Remove(objCell As Range, strPattern As String)
Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Global = True
RegEx.Pattern = strPattern
Remove = RegEx.Replace(objCell.Value, "")
End Function
Here is the link to the XLSM file which contains the data I have:
https://www.dropbox.com/s/et9ee727ompj5fl/Regex%20Trials.xlsm?dl=0
and here is a screenshot to show you what I am looking for:
Not 100% perfect for words but should get you started
Breakdown of RegEx (\d+\:)+\d+
(\d+\:) finds any patterns that match the format x:
the plus after the bracket then tells it that this is a repeating pattern.
lastly the \d+ matches the last digit in the string so that the regex will find a pattern that matches x:x:x
The next RegEx (?!l-|al-|a-|wa-|fa-|bi-)[a-z].* is a lot more complex.
First of all lets look at the [a-z]. This tells it to match any character between a and z. We then want to capture the rest of the word so by using .* it captures everything from the first match to the end of the string (this includes non a-z characters). However, we don't want it to capture the first part of the string before the hyphen (in most cases) so by using ?! We use what's called negative look ahead. This looks for anything inside the brackets and ignores those bits. | simply means or. so anything inside that bracket will be ignored from the match.
Go to http://regexr.com/ if you want to have a play around is a handy site to learn/test RegEx
Public Sub test()
Dim rng As Range
Dim matches
Dim c
With Sheet1
Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
End With
For Each c In rng
With c
.Offset(0, 6) = ExecuteRegEx(.Value2, "(\d+\:)+\d+")
.Offset(0, 7) = ExecuteRegEx(.Value2, "(?!l-|al-|a-|wa-|fa-|bi-)[a-z].*")
End With
Next c
End Sub
Public Function ExecuteRegEx(str As String, pattern As String) As String
Dim RegEx As Object
Dim matches
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.ignorecase = False
.pattern = pattern
If .test(str) Then
Set matches = .Execute(str)
ExecuteRegEx = matches(0)
Else
ExecuteRegEx = vbNullString
End If
End With
End Function
I wouldn't use a regex for this: you can do some splitting of the cell value and testing of the prefixs against a defined array of prefixs:
Note: the array values are in an order where substrings of other prefixs are later in the list
Public Function RemovePrefix(RngSrc As Range) As String
If RngSrc.Count > 1 Then Exit Function
On Error GoTo ExitFunction
Dim Prefixs() As String: Prefixs = Split("wal,wa',wa,bil,bi,fa", ",")
Dim Arr() As String, i As Long, Temp As String
Arr = Split(RngSrc, "-")
If UBound(Arr) > 0 Then
RemovePrefix = Arr(UBound(Arr))
Exit Function
End If
Arr = Split(RngSrc, " ")
For i = 0 To UBound(Prefixs)
Temp = Arr(UBound(Arr))
If InStr(Temp, Prefixs(i)) = 1 Then
RemovePrefix = Right(Temp, Len(Temp) - Len(Prefixs(i)))
Exit Function
End If
Next i
RemovePrefix = Temp
ExitFunction:
If Err Then RemovePrefix = "Error"
End Function
I'm looking for a simple Excel VBA or formula that can convert an entire row in Excel from 'number stored as Text' to an actual Number for vlookup reasons.
Can anyone point me in the right direction?
Better Approach
You should use INDEX(MATCH) instead of VLOOKUP because VLOOKUP behaves in an unpredictable manner which causes errors, such as the one you're presumably experiencing.
INDEX ( <return array> , MATCH ( <lookup value> , <lookup array> , 0) )
Using 0 as the last argument to MATCH means the match must be exact
Here is some more in-depth information on INDEX(MATCH)-ing
Further
Add zero +0 to convert a value to a number.
This can be (dangerously) extended with IFERROR() to turn non-numeric text into a zero:
=A2+0
=IFERROR(A2+0,0)
For the inverse, you can catenate an empty string &"" to force the value to be a string.
Notes
If 0 is not used as the last argument to MATCH, it will find all sorts of unexpected "matches" .. and worse, it may find a different value even when an exact match is present.
It often makes sense to do some extra work to determine if there are duplicates in the MATCH lookup column, otherwise the first value found will be returned (see example).
Help with MATCH comes from here, notably the matching logic the 3rd argument controls.
This should work if you add it before your vlookup or index/match lines:
Sheets("Sheet1").UsedRange.Value = Sheets("Sheet1").UsedRange.Value
I did find this, but does anyone have a formula as well?
Sub macro()
Range("F:F").Select 'specify the range which suits your purpose
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
End Sub
http://www.ozgrid.com/forum/showthread.php?t=64027
Try this:
Sub ConvertToNumber()
Application.ScreenUpdating = False
Dim cl As Range
For Each cl In Selection.Cells
cl.Value = CInt(cl.Value)
Next cl
Application.ScreenUpdating = True
End Sub
To use it, simply select the relevant block of cells with the mouse, and then run the macro (Alt+F8 to bring up the dialogue box). It will go through each cell in the selected range and convert whatever value it holds into a number.
I wrote a custom vlookup function that doesn't care about data formats. Put this into a module in VBA and use = VLOOK instead of = VLOOKUP
Public Function VLook(sValue As String, rDest As Range, iColNo As Integer)
' custom vlookup that's insensitive to data formats
Dim iLastRow As Long
Dim wsDest As Worksheet
Set wsDest = Sheets(rDest.Parent.Name)
iLastRow = wsDest.Range(wsDest.Cells(100000, rDest.Column).Address).End(xlUp).Row
If iLastRow < rDest.Row + rDest.Rows.Count Then
For X = rDest.Column To rDest.Column + rDest.Columns.Count
If wsDest.Cells(100000, X).End(xlUp).Row > iLastRow Then iLastRow = wsDest.Cells(100000, X).End(xlUp).Row
Next X
End If
sValue = UCase(Application.Clean(Trim(sValue)))
For X = rDest.Row To iLastRow
If UCase(Application.Clean(Trim(wsDest.Cells(X, rDest.Column)))) = sValue Then
VLookDM = wsDest.Cells(X, rDest.Column + iColNo - 1)
Exit For
End If
Next X
End Function
The easiest way I can think of is using the built-in function =VALUE(TEXT_TO_CONVERT_TO_STRING).
I am working on a budget in excel 2007. It was written by someone else and contains many sheets and many formulas. I am trying to make the spreadsheet more efficient by creating an Input worksheet where all/most constants would be entered. To help with this process, I would like to be able to highlight all formulas that contain constants as well as highlight all constants (not in formulas) within my selection. Or, if easier, the opposite, highlight all formulas that do not contain constants within my selection. I am mainly dealing with numbers, not text.
Here are examples of formulas(=) with constants and just constants:
=82000-50000
=$A$2-50000
=A2-50000
=F133***.05**
50000
Here are examples of formulas(=) that do not contain constants:
=SUM(E8:P8)
=$C$51*'Servicing Detail'!$E$181
=K152
The closest answer I could find to my question was here: How to determine if a cell formula contains Constants?. But I believe this post to be specific to finding quotations within a formula as Siddharth Rout clarified in his last comment.
Any help would be greatly appreciated. Thank you. (This is my first post and hope that I have formatted correctly. Apologies in advance)
You can parse formulas using the SPLIT function in VBA. E.g. the code below works for the examples you have given. Returns TRUE if formula contains constants, returns N/A if it is not a formula and FALSE otherwise.
Probably you have to adapt a little bit so it works in all cases, but it's a good starting point.
Function HasConstant(r As Range) As Variant
Application.Volatile
Dim formula As String
Dim delimiters() As String
Dim delimiter As Variant
Dim Components() As String
Dim component As Variant
Dim chars As Integer
delimiters() = Split("+ - * / = & ( ) ,")
If r.HasFormula Then
formula = Right(r.formula, Len(r.formula) - 1)
Do Until formula = ""
chars = Len(formula)
component = formula
For Each delimiter In delimiters
Components = Split(formula, delimiter)
If Len(Components(0)) < chars And Len(Components(0)) > 0 Then
component = Components(0)
chars = Len(component)
End If
Next
If IsNumeric(Replace(component, ".", Application.International(xlDecimalSeparator))) Then 'IsNumeric(component)
HasConstant = True
Exit Function
ElseIf Left(CStr(component), 1) = Chr(34) And Right(CStr(component), 1) = Chr(34) Then
HasConstant = True
Exit Function
End If
If chars < Len(formula) Then
formula = Right(formula, Len(formula) - chars - 1)
Else
formula = ""
End If
Loop
Else
HasConstant = CVErr(xlErrNA)
Exit Function
End If
HasConstant = False
End Function
Example: