extract and convert string into decimal number using excel VBA - excel

Question

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.

Answer 1

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

Answer 2

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.

Answer 3

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?