How to add decimal and remove text from alphanumerical string - vba

I have a huge amount of data which is alphanumerical and I need to convert it to purely numerical. Which no text in the string.
Ex.
C0424.100 ---> 424.100 (or 0424.100)
There always is 3 places after the decimal. Any tips on how to go about this? I'm pretty new to VBA. So basically I need to remove all text and a decimal with three digits to the right of it.

This is well described in String functions and how to use them
However, this should get you started. I would handle the formatting in Excel afterwards, but this is the simple string to number conversion. If the strings are more complex, consider using the Search string function to find the numbers, then use Right, Left, Mid functions to trim the string. Lastly use the CDbl() function to convert the string to the double.
Macro code as follows:
Sub temp()
'
' temp Macro
Range("A2").Select
stringToConvert = Selection.Value
trimmedString = Right(stringToConvert, Len(stringToConvert) - 1)
numberToDisplay = CDbl(trimmedString)
Range("A3").Value = numberToDisplay
End Sub

Do you even need VBA? If your data always has just one leading alpha character then you can just use standard Excel functions. For an entry in A2 that you want to convert, place the following formula in a convenient cell (e.g. B2):
=VALUE(RIGHT(A2,LEN(A2)-1))

I got UDF options for you.
Option 1: If you want to remove all the alphas from the beginning of string:
Function RemoveFirstAlphas(txt As String) As String
Dim i As Long
For i = 1 To Len(txt)
Select Case Mid$(txt, i, 1)
Case "0" To "9": Exit For
Case Else: Mid$(txt, i, 1) = Chr(32)
End Select
Next
RemoveFirstAlphas = Trim(txt)
End Function
Option 2: If you want to remove all the alphas from entire string:
Function RemoveAllAlphas(txt As String) As String
Dim ObjRegex As Object
Set ObjRegex = CreateObject("vbscript.regexp")
With ObjRegex
.Global = True
.Pattern = "[a-zA-Z\s]+"
RemoveAllAlphas = .Replace(Replace(txt, "-", Chr(32)), vbNullString)
End With
End Function

No need for VBA. Something like:
=--MID(A1,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A1&"0123456789")),99)
will return the string starting with the first digit, and convert it to a numeric value. You can then format it in the cell however you wish.
The above will work with any number of non-digit leading characters. If will only have a single non-digit character, then #Skippy answer is simpler
If you have to have a VBA routine, something like the following should work -- it will extract the first numeric substring in the string. It does not matter if there are non-digits before or after. And, if there are no digits, the function will return the #NUM! error
Option Explicit
Function ExtractNums(S As String) As Variant
Dim I As Long
For I = 1 To Len(S)
If IsNumeric(Mid(S, I, 1)) Then
ExtractNums = Val(Mid(S, I))
Exit Function
End If
Next I
ExtractNums = CVErr(xlErrNum)
End Function

Related

Split cells into 2 columns when any number

I can see numerous posts around this topic but none that specifically solves the problem I have.
I have a string that has text and numbers. I need to split the string into 2 columns when it first sees a number.
Example:
Ballyvic Boru5/6
First Drift2/1
Sizing Cusimanoin15/2
Becomes:
You can use a simple formula to find the first number, along with LEFT and MID to split the string.
Part 1:
=LEFT(A1,MIN(FIND({1,2,3,4,5,6,7,8,9,0},A1&"1234567890"))-1)
Part 2:
=MID(A1,MIN(FIND({1,2,3,4,5,6,7,8,9,0},A1&"1234567890")),99)
Here's a regex method:
You must set a reference to Microsoft VBScript Regular Expressions x.x, where x.x is the highest version you have (mine is 5.5)
Option Explicit
Sub splitCells()
Dim RegEx As New RegExp, i As Long, tempStr As String
With RegEx
.Global = True
.IgnoreCase = True
.Pattern = "(([a-z]*\s?)*\D)(\d.*)"
End With
With ThisWorkbook.Worksheets(1)
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If RegEx.Test(.Cells(i, 1)) Then
tempStr = .Cells(i, 1)
.Cells(i, 1) = RegEx.Replace(tempStr, "$1")
.Cells(i, 2) = RegEx.Replace(tempStr, "$3")
End If
Next i
End With
End Sub
Breaking down the Regular Expression:
(([a-z]*\s?)*\D)(\d.*)
[a-z]* matches any character in the alphabet, with the * multiplier for unlimited occurances
\s? Matches any whitespace character, with the ? multiplier to match 0-1 occurances (meaning there may or may not be a white space
Both of the above is enclosed in a grouping (), followed by another * to match 0-unlimited occurances
\D This excludes all digits
The above is enclosed in a group with the first (([..])*\D)
We have our final group: (\d.*), which matches the first digit and everything else afterwards.
Here's a pair functions you can use on the worksheet (as opposed to having to run a VBA procedure to 'fix' the cells one time):
Public Function splitNum1(str As String) As String
Dim p
For p = 1 To Len(str)
If Mid(str, p, 1) Like "#" Then Exit For
Next
splitNum1 = Left(str, p - 1)
End Function
Public Function splitNum2(str As String) As String
splitNum2 = Right(str, Len(str) - Len(splitNum1(str)))
End Function
splitNum1 returns the string on the "left" side of the number.
splitNum2 returns the string beginning with the first nummber.

Excel VBA Using wildcard to replace string within string

I have a difficult situation and so far no luck in finding a solution.
My VBA collects number figures like $80,000.50. and I'm trying to get VBA to remove the last period to make it look like $80,000.50 but without using right().
The problem is after the last period there are hidden spaces or characters which will be a whole lot of new issue to handle so I'm just looking for something like:
replace("$80,000.50.",".**.",".**")
Is this possible in VBA?
I cant leave a comment so....
what about InStrRev?
Private Sub this()
Dim this As String
this = "$80,000.50."
this = Left(this, InStrRev(this, ".") - 1)
Debug.Print ; this
End Sub
Mid + Find
You can use Mid and Find functions. Like so:
The Find will find the first dot . character. If all the values you are collecting are currency with 2 decimals, stored as text, this will work well.
The formula is: =MID(A2,1,FIND(".",A2)+2)
VBA solution
Function getStringToFirstOccurence(inputUser As String, FindWhat As String) As String
getStringToFirstOccurence = Mid(inputUser, 1, WorksheetFunction.Find(FindWhat, inputUser) + 2)
End Function
Other possible solutions, hints
Trim + Clear + Substitute(Char(160)): Chandoo -
Untrimmable Spaces – Excel Formula
Ultimately, you can implement Regular expressions into Excel UDF: VBScript’s Regular Expression Support
How about:
Sub dural()
Dim r As Range
For Each r In Selection
s = r.Text
l = Len(s)
For i = l To 1 Step -1
If Mid(s, i, 1) = "." Then
r.Value = Mid(s, 1, i - 1) & Mid(s, i + 1)
Exit For
End If
Next i
Next r
End Sub
This will remove the last period and leave all the other characters intact. Before:
and after:
EDIT#1:
This version does not require looping over the characters in the cell:
Sub qwerty()
Dim r As Range
For Each r In Selection
If InStr(r.Value, ".") > 0 Then r.Characters(InStrRev(r.Text, "."), 1).Delete
Next r
End Sub
Shortest Solution
Simply use the Val command. I assume this is meant to be a numerical figure anyway? Get rid of commas and the dollar sign, then convert to value, which will ignore the second point and any other trailing characters! Robustness not tested, but seems to work...
Dim myString as String
myString = "$80,000.50. junk characters "
' Remove commas and dollar signs, then convert to value.
Dim myVal as Double
myVal = Val(Replace(Replace(myString,"$",""),",",""))
' >> myVal = 80000.5
' If you're really set on getting a formatted string back, use Format:
myString = Format(myVal, "$000,000.00")
' >> myString = $80,000.50
From the Documentation,
The Val function stops reading the string at the first character it can't recognize as part of a number. Symbols and characters that are often considered parts of numeric values, such as dollar signs and commas, are not recognized.
This is why we must first remove the dollar sign, and why it ignores all the junk after the second dot, or for that matter anything non numerical at the end!
Working with Strings
Edit: I wrote this solution first but now think the above method is more comprehensive and shorter - left here for completeness.
Trim() removes whitespace at the end of a string. Then you could simply use Left() to get rid of the last point...
' String with trailing spaces and a final dot
Dim myString as String
myString = "$80,000.50. "
' Get rid of whitespace at end
myString = Trim(myString)
' Might as well check if there is a final dot before removing it
If Right(myString, 1) = "." Then
myString = Left(myString, Len(myString) - 1)
End If
' >> myString = "$80,000.50"

VBA - How to check if a String is a valid hex color code?

To prevent errors, I need to check if a String retrieved from a custom input box is not a valid hex color code. So far I found various solutions for other languages, but none for VBA.
Working on the following code, giving a not hex value input will cause a run time error. That's critical to my project, since I am working on a protected sheet.
Public Function HexWindow(MyCell As String, Description As String, Caption As String)
Dim myValue As Variant
Dim priorValue As Variant
priorValue = Range(MyCell).Value
myValue = InputBox(Description, Caption, Range(MyCell).Value)
Range(MyCell).Value = myValue
If myValue = Empty Then
Range(MyCell).Value = priorValue
End If
tHex = Mid(Range(MyCell).Text, 6, 2) & Mid(Range(MyCell).Text, 4, 2) & Mid(Range(MyCell).Text, 2, 2)
Range(MyCell).Interior.Color = WorksheetFunction.Hex2Dec(tHex)
End Function
How can I set a condition that recognizes a value not being in the format of "#" & 6 characters from 0-9 and A-F in any case?
Couple ways to do this. The easiest way is with a regular expression:
'Requires reference to Microsoft VBScript Regular Expressions x.x
Private Function IsHex(inValue As String) As Boolean
With New RegExp
.Pattern = "^#[0-9A-F]{1,6}$"
.IgnoreCase = True 'Optional depending on your requirement
IsHex = .Test(inValue)
End With
End Function
If for some reason that doesn't appeal to you, you could also take advantage of VBA's permissive casting of hex strings to numbers:
Private Function IsHex(ByVal inValue As String) As Boolean
If Left$(inValue, 1) <> "#" Then Exit Function
inValue = Replace$(inValue, "#", "&H")
On Error Resume Next
Dim hexValue As Long
hexValue = CLng(inValue) 'Type mismatch if not a number.
If Err.Number = 0 And hexValue < 16 ^ 6 Then
IsHex = True
End If
End Function
I would use regular expressions for this. First you must go to Tools-->Referencesin the VBA editor (alt-f11) and make sure this library is checked
Microsoft VBScript Regular Expressions 5.5
Then you could modify this sample code to meet your needs
Sub RegEx_Tester()
Set objRegExp_1 = CreateObject("vbscript.regexp")
objRegExp_1.Global = True
objRegExp_1.IgnoreCase = True
objRegExp_1.Pattern = "#[a-z0-9]{6}"
strToSearch = "#AAFFDD"
Set regExp_Matches = objRegExp_1.Execute(strToSearch)
If regExp_Matches.Count = 1 Then
MsgBox ("This string is a valid hex code.")
End If
End Sub
The main feature of this code is this
objRegExp_1.Pattern = "#[a-z,A-Z,0-9]{6}"
It says that you will accept a string that has a # followed by any 6 characters that are a combination of upper case or lower case strings or numbers 0-9. strToSearch is just the string you are testing to see if it is a valid color hex string. I believe this should help you.
I should credit this site. You may want to check it out if you want a crash course on regular expressions. They're great once you learn how to use them.

Excell cell value is not read as Number?

I am trying to add the data in the two cells of the excel sheet but even if the excel cell is of the type number it does not add up the cells. It seems that there is space infornt of the number that it does not add....image is below.
Is there a vba code to remove this space from each of the cell if its presesnt.
I have exported the excel from a pdf.
Excel will attempt to convert any value to a number if you apply an operator to it, and this conversion will handle spaces. So you can use =A1*1 or A1+0 to convert a value in A1 to a number, or something like this within a function =SUM(IFERROR(A1*1,0)).
That kind of implicit conversion automatically performs a trim(). You can also do this conversion explicitly by using the funciton N(), or NumberValue() for newer versions of Excel. However, as others have pointed out, many characters won't be automatically handled and you may need to use Substitute() to remove them. For instance, Substitute(A1,160,"") for a non-breaking space, a prime suspect because of its prevalence in html. The Clean() function can give you a shortcut by doing this for a bunch of characters that are known to be problematic, but it's not comprehensive and you still need to add your own handling for a non-breaking space. You can find the ASCII code for any specific characters that are grieving you by using the Code() function... for instance Code(Mid(A1,1,1))
Character Handling UDF
The UDF below gives flexibility to the character handling approach by allowing multiple characters to be removed from every cell in a range, and produces a result that can be used as an argument. For example, Sum(RemoveChar(A1:A5,160)) would remove all non-breaking spaces from the range being summed. Multiple characters can removed by being specified in either a range or array, for example Sum(RemoveChar(A1:A5,B1:B3)) or Sum(RemoveChar(A1:A5,{160,150})).
Function RemoveChar(R As Range, ParamArray ChVal() As Variant)
Dim x As Variant
Dim ResVals() As Variant
ReDim ResVals(1 To R.Count)
'Loop through range
For j = 1 To R.Count
x = R(j).Value2
If x <> Empty Then
'Try treating character argument as array
'If that fails, then try treating as Range
On Error Resume Next
For i = 1 To UBound(ChVal(0))
x = Replace(x, Chr(ChVal(0)(i)), "")
Next
If Err = 92 Then
Err.Clear
For Each Rng In ChVal(0)
x = Replace(x, Chr(Rng.Value2), "")
Next
End If
Err.Raise (Err)
On Error GoTo 0
'If numeric then convert to number
'so that numbers will be treated as such
'when array is passed as an argument
If IsNumeric(x) Then
ResVals(j) = Val(x)
Else
ResVals(j) = x
End If
End If
Next
'Return array of type variant
RemoveChar = ResVals
End Function
Numeric Verifying UDF
The drawback with replacing characters is that it's not comprehensive. If you want something that's more of a catch-all, then perhaps something like this.
Function GetNumValues(R As Range)
Dim c, temp As String
Dim NumVals() As Double
ReDim NumVals(1 To R.Count)
'Loop through range
For j = 1 To R.Count
'Loop through characters
'Allow for initial short-circuit if already numeric
For i = 1 To Len(R(j).Value2)
c = Mid(R(j).Value2, i, 1)
'If character is valid for number then include in temp string
If IsNumeric(c) Or c = Application.DecimalSeparator Or c = Application.ThousandsSeparator Then
temp = temp + c
End If
Next
'Assign temp string to array of type double
'Use Val() function to convert string to number
NumVals(j) = Val(temp)
'Reset temp string
temp = Empty
Next
'Return array of type double
GetNumValues = NumVals
End Function

Search cell for text and copy text to another cell in VBA?

I've got a column which contains rows that have parameters in them. For example
W2 = [PROD][FO][2.0][Customer]
W3 = [PROD][GD][1.0][P3]
W4 = Issues in production for customer
I have a function that is copying other columns into another sheet, however for this column, I need to do the following
Search the cell and look for [P*]
The asterisk represents a number between 1 and 5
If it finds [P*] then copy P* to the sheet "Calculations" in column 4
Basically, remove everything from the cell except where there is a square bracket, followed by P, a number and a square bracket
Does anyone know how I can do this? Alternatively, it might be easier to copy the column across and then remove everything that doesn't meet the above criteria.
Second Edit:
I edited here to use a regular expression instead of a loop. This may be the most efficient method to achieve your goal. See below and let us know if it works for you:
Function MatchWithRegex(sInput As String) As String
Dim oReg As Object
Dim sOutput As String
Set oReg = CreateObject("VBScript.RegExp")
With oReg
.Pattern = "[[](P[1-5])[]]"
End With
If oReg.test(sInput) Then
sOutput = oReg.Execute(sInput)(0).Submatches(0)
Else
sOutput = ""
End If
MatchWithRegex = sOutput
End Function
Sub test2()
Dim a As String
a = MatchWithRegex(Range("A1").Value)
If a = vbNullString Then
MsgBox "None"
Else
MsgBox MatchWithRegex(Range("A1").Value)
End If
End Sub
First EDIT:
My solution would be something as follows. I'd write a function that first tests if the Pattern exists in the string, then if it does, I'd split it based on brackets, and choose the bracket that matches the pattern. Let me know if that works for you.
Function ExtractPNumber(sInput As String) As String
Dim aValues
Dim sOutput As String
sOutput = ""
If sInput Like "*[[]P[1-5][]]*" Then
aValues = Split(sInput, "[")
For Each aVal In aValues
If aVal Like "P[1-5][]]*" Then
sOutput = aVal
End If
Next aVal
End If
ExtractPNumber = Left(sOutput, 2)
End Function
Sub TestFunction()
Dim sPValue As String
sPValue = ExtractPNumber(Range("A2").Value)
If sPValue = vbNullString Then
'Do nothing or input whatever business logic you want
Else
Sheet2.Range("A1").Value = sPValue
End If
End Sub
OLD POST:
In VBA, you can use the Like Operator with a Pattern to represent an Open Bracket, the letter P, any number from 1-5, then a Closed Bracket using the below syntax:
Range("A1").Value LIke "*[[]P[1-5][]]*"
EDIT: Fixed faulty solution
If you're ok with blanks and don't care if *>5, I would do this and copy down column 4:
=IF(ISNUMBER(SEARCH("[P?]",FirstSheet!$W2)), FirstSheet!$W2, "")
Important things to note:
? is the wildcard symbol for a single character; you can use * if you're ok with multiple characters at that location
will display cell's original value if found, leave blank otherwise
Afterwards, you can highlight the column and remove blanks if needed. Alternatively, you can replace the blank with a placeholder string.
If * must be 1-5, use two columns, E and D, respectively:
=MID(FirstSheet!$W2,SEARCH("[P",FirstSheet!$W2)+2,1)
=IF(AND(ISNUMBER($E2),$E2>0,$E2<=5,MID($W2,SEARCH("[P",FirstSheet!$W2)+3,1))), FirstSheet!$W2, "")
where FirstSheet is the name of your initial sheet.