Consider the following example: Lets say you want to make a function "JoinIfs" that works just like SUMIFS except instead of adding the values in the SumRange, it concatenates the values in "JoinRange". Is there a way to nest the ParamArray as it seems to be done in SUMIFS?
SUMIFS(sum_range, criteria_range1, criteria1, [criteria_range2, criteria2], ...)
I imagine the declaration should look something like this:
Function JoinIfs(JoinRange As Variant, _
Delim As String, _
IncludeNull As Boolean, _
ParamArray CritArray(CriteriaRange As Variant, Criteria As Variant)) As String
But nothing I try seems to compile and there might not be a way to nest ParamArrays. But the existence of functions like SUMIFS and COUNTIFS seems to suggest there might be a way to nest the ParamArrays.
This question duplicates AlexR's question Excel UDF with ParamArray constraint like SUMIFS. But that was posted a few years ago with no response so either the question didn't get enough attention or it was misunderstood.
Edit for clarification: This question is specifically about nesting ParamArrays. I'm not trying to find alternative methods of achieving the outcome of the example above. Imagine nesting ParamArrays on a completely different fictional function like "AverageIfs"
As per the documentation for the Function statement and Sub statement, a Function or Sub can only contain 1 ParamArray, and it must be the last argument.
However, you can pass an Array as an Argument to a ParamArray. Furthermore, you can then check how many elements are in the ParamArray, and throw an error if it isn't an even number. For example, this demonstration takes a list of Arrays, and which element in that array to take, and outputs another array with the results:
Sub DemonstrateParamArray()
Dim TestArray As Variant
TestArray = HasParamArray(Array("First", "Second"), 0)
MsgBox TestArray(0)
Dim AnotherArray As Variant
AnotherArray = Array("Hello", "World")
TestArray = HasParamArray(AnotherArray, 0, AnotherArray, 1)
MsgBox Join(TestArray, " ")
End Sub
Function HasParamArray(ParamArray ArgList() As Variant) As Variant
Dim ArgumentCount As Long, WhichPair As Long, Output() As Variant, WhatElement As Long
ArgumentCount = 1 + UBound(ArgList) - LBound(ArgList)
'Only allow Even Numbers!
If ArgumentCount Mod 2 = 1 Then
Err.Raise 450 '"Wrong number of arguments or invalid property assignment"
Exit Function
End If
ReDim Output(0 To Int(ArgumentCount / 1) - 1)
For WhichPair = LBound(ArgList) To ArgumentCount + LBound(ArgList) - 1 Step 2
WhatElement = ArgumentCount(WhichPair + 1)
Output(Int(WhichPair / 2)) = ArgumentCount(WhichPair)(WhatElement)
Next WhichPair
HasParameterArray = Output
End Function
(A list of built-in error codes for Err.Raise can be found here)
It seems like nesting a ParamArray is not possible.
I was hoping to get a function that looks like Excel's built in functions.
SUMIFS, for example seems to group pairs of parameters in a very neat way.
Based on the inputs of some users I made the following Function which seems to work quite well.
Function SJoinIfs(JoinRange As Variant, Sep As String, IncludeNull As Boolean, ParamArray CritArray() As Variant) As Variant
'Concatenates text based on multple criteria similar to SUMIFS.
'Sizes of ranges CritArray (0, 2, 4 ...) must match size of range JoinRange. CritArray must have an even amount of elements
'Elements of CritArray (1, 3, 5 ...) must be single values
Set JoinList = CreateObject("System.Collections.Arraylist")
'Set FinalList = CreateObject("System.Collections.Arraylist")
For Each DataPoint In JoinRange
JoinList.Add (CStr(DataPoint))
Next
JoinArray = JoinList.ToArray
CriteriaCount = UBound(CritArray) + 1
If CriteriaCount Mod 2 = 0 Then
CriteriaSetCount = Int(CriteriaCount / 2)
Set CriteriaLists = CreateObject("System.Collections.Arraylist")
Set CriteriaList = CreateObject("System.Collections.Arraylist")
Set MatchList = CreateObject("System.Collections.Arraylist")
For a = 0 To CriteriaSetCount - 1
CriteriaList.Clear
For Each CriteriaTest In CritArray(2 * a)
CriteriaList.Add (CStr(CriteriaTest))
Next
If CriteriaList.count <> JoinList.count Then 'Ranges are different sizes
SJoinIfs = CVErr(xlErrRef)
Exit Function
End If
MatchList.Add (CStr(CritArray((2 * a) + 1)))
CriteriaLists.Add (CriteriaList.ToArray)
Next
JoinList.Clear
For a = 0 To UBound(JoinArray)
AllMatch = True
For b = 0 To MatchList.count - 1
AllMatch = (MatchList(b) = CriteriaLists(b)(a)) And AllMatch
Next
If AllMatch Then JoinList.Add (JoinArray(a))
Next
SJoinIfs = SJoin(Sep, IncludeNull, JoinList)
Else 'Criteria Array Size is not even
SJoinIfs = CVErr(xlErrRef)
Exit Function
End If
End Function
This function makes use of another function SJoin() which I adapted some time ago based on the answer provided by Lun in his answer to How to replicate Excel's TEXTJOIN function in VBA UDF that allows array inputs.
I have adapted this Function to include the use of Numericals, VBA Arrays and Arraylists as well.
On Error Resume Next
'Sep is the separator, set to "" if you don't want any separator. Separator must be string or single cell, not cell range
'TxtRng is the content you want to join. TxtRng can be string, single cell, cell range or array returned from an array function. Empty content will be ignored
Dim OutStr As String 'the output string
Dim i, j, k, l As Integer 'counters
Dim FinArr(), element As Variant 'the final array and a temporary element when transfering between the two arrays
'Go through each item of TxtRng(), depending on the item type, transform and put it into FinArray()
i = 0 'the counter for TxtRng
j = 0 'the counter for FinArr
k = 0: l = 0 'the counters for the case of array from Excel array formula
Do While i < UBound(TxtRng) + 1
If TypeName(TxtRng(i)) = "String" Then 'specified string like "t"
ReDim Preserve FinArr(0 To j)
FinArr(j) = "blah"
FinArr(j) = TxtRng(i)
j = j + 1
ElseIf TypeName(TxtRng(i)) = "Range" Then 'single cell or range of cell like A1, A1:A2
For Each element In TxtRng(i)
ReDim Preserve FinArr(0 To j)
FinArr(j) = element
j = j + 1
Next
ElseIf TypeName(TxtRng(i)) = "Variant()" Then 'array returned from an Excel array formula
For k = LBound(TxtRng(0), 1) To UBound(TxtRng(0), 1)
For l = LBound(TxtRng(0), 2) To UBound(TxtRng(0), 2)
ReDim Preserve FinArr(0 To j)
FinArr(j) = TxtRng(0)(k, l)
j = j + 1
Next
Next
Else
TJoin = CVErr(xlErrValue)
Exit Function
End If
i = i + 1
Loop
'Put each element of the new array into the join string
For i = LBound(FinArr) To UBound(FinArr)
If FinArr(i) <> "" Then 'Remove this line if you want to include empty strings
OutStr = OutStr & FinArr(i) & Sep
End If
Next
TJoin = Left(OutStr, Len(OutStr) - Len(Sep)) 'remove the ending separator
End Function
Thanks to all who contributed to this question.
I created an assessment that applicants fill out in Excel. I have a key where I copy their answers in and it tells me if their answers match my key. I'd like to add a formula that will also show me the differences between the applicant's cell (B2) and the key's cell (A2), to make it easier to see what they got wrong.
I tried using =SUBSTITUTE(B2,A2,"") but this only gives me differences at the beginning or end of the string. Usually, the difference is in the middle.
For example, my key (cell A2) might say: Cold War | Bay of Pigs | Fidel Castro
And the applicant (cell B2) might say: Cold War | Cuban Missile Crisis | Fidel Castro
I want this formula to return: "Cuban Missile Crisis"
You may try something like this...
Function CompareStrings(keyRng As Range, ansRng As Range) As String
Dim arr() As String
Dim i As Long
arr() = Split(ansRng.Value, "|")
For i = 0 To UBound(arr)
If InStr(keyRng.Value, arr(i)) = 0 Then
CompareStrings = arr(i)
Exit Function
End If
Next i
End Function
Then you can use this UDF like below...
=CompareStrings(A2,B2)
If you want to compare them in the reverse order also and return the not matched string part from any of them, try this...
Function CompareStrings(ByVal keyRng As Range, ByVal ansRng As Range) As String
Dim arr() As String
Dim i As Long
Dim found As Boolean
arr() = Split(ansRng.Value, "|")
For i = 0 To UBound(arr)
If InStr(keyRng.Value, Trim(arr(i))) = 0 Then
found = True
CompareStrings = arr(i)
Exit Function
End If
Next i
If Not found Then
arr() = Split(keyRng.Value, "|")
For i = 0 To UBound(arr)
If InStr(ansRng.Value, Trim(arr(i))) = 0 Then
CompareStrings = arr(i)
Exit Function
End If
Next i
End If
End Function
Use this as before like below...
=CompareStrings(A2,B2)
So the function will first compare all the string parts of B2 with A2 and if it finds any mismatch, it will return that part of string and if it doesn't find any mismatch, it will then compare all the parts of string in A2 with B2 and will return any mismatch part of string. So it will compare both ways.
The function above displays only the first difference. Here is an update that displays all differences between two strings.enter image description here
Function CompareStrings(ByVal keyRng As Range, ByVal ansRng As Range) As String
Dim arr() As String
Dim i As Long
arr() = Split(ansRng.Value, " ")
CompareStrings = "+["
For i = 0 To UBound(arr)
If InStr(keyRng.Value, Trim(arr(i))) = 0 Then
CompareStrings = CompareStrings & " " & arr(i)
End If
Next i
CompareStrings = CompareStrings & " ] -["
arr() = Split(keyRng.Value, " ")
For i = 0 To UBound(arr)
If InStr(ansRng.Value, Trim(arr(i))) = 0 Then
CompareStrings = CompareStrings & " " & arr(i)
End If
Next i
CompareStrings = CompareStrings & " ]"
End Function
I'd like to create a function in vba to extract the first nth words from a string and to look like this
ExtractWords(affected_text, delimiter, number_of_words_to_extract)
I tried a solution but it only extracts the first two words.
Function FirstWords(myStr As Variant, delimiter,words_to_extract) As Variant
FirstWords = Left(myStr, InStr(InStr(1, myStr, delimiter) + 1, myStr, delimiter, vbTextCompare) - 1)
End Function
Any ideas? Thanks
Use Split() function. It returns array of String, split using the delimiter and limit of words you specify.
Dim Result As Variant
Result = Split("Alice,Bob,Chuck,Dave", ",") 'Result: {"Alice,"Bob","Chuck","Dave"}
Result = Split("Alice,Bob,Chuck,Dave", ",", 2) 'Result: {"Alice,"Bob"}
#Taosique's answer using Split is excellent, but if you want the result returned as a string you can do the following:
Function FirstWords(myStr As String, delimiter As String, words_to_extract As Long) As Variant
Dim i As Long, k As Long
For i = 1 To Len(myStr)
If Mid(myStr, i, 1) = delimiter Then
k = k + 1
If k = words_to_extract Then
FirstWords = Mid(myStr, 1, i)
Exit Function
End If
End If
Next I
'if you get to here -- trouble
'unless the delimiter count is words_to_extract - 1
If k = words_to_extract - 1 Then
FirstWords = myStr
Else
FirstWords = CVErr(xlErrValue)
End If End Function
Sub test()
Debug.Print FirstWords("This is a test. I hope it works", " ", 4)
Debug.Print FirstWords("This is a test. I hope it works", " ", 10)
End Sub
When test is run it first displays the string "This is a test." then prints an error condition.
Much the same effect as the above can be achieved by first splitting the string using Split and then rejoining it using Join. A subtle difference is the behavior if there are less than words_to_extract words. The Split then Join approach will return the whole string. The above code treats this as an error condition and, if used as a UDF worksheet function, will display #VALUE! in any cell that contains it.
Does anyone have an Excel VBA function which can return the column letter(s) from a number?
For example, entering 100 should return CV.
This function returns the column letter for a given column number.
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
testing code for column 100
Sub Test()
MsgBox Col_Letter(100)
End Sub
If you'd rather not use a range object:
Function ColumnLetter(ColumnNumber As Long) As String
Dim n As Long
Dim c As Byte
Dim s As String
n = ColumnNumber
Do
c = ((n - 1) Mod 26)
s = Chr(c + 65) & s
n = (n - c) \ 26
Loop While n > 0
ColumnLetter = s
End Function
Something that works for me is:
Cells(Row,Column).Address
This will return the $AE$1 format reference for you.
For example: MsgBox Columns( 9347 ).Address returns .
To return ONLY the column letter(s): Split((Columns(Column Index).Address(,0)),":")(0)
For example: MsgBox Split((Columns( 2734 ).Address(,0)),":")(0) returns .
And a solution using recursion:
Function ColumnNumberToLetter(iCol As Long) As String
Dim lAlpha As Long
Dim lRemainder As Long
If iCol <= 26 Then
ColumnNumberToLetter = Chr(iCol + 64)
Else
lRemainder = iCol Mod 26
lAlpha = Int(iCol / 26)
If lRemainder = 0 Then
lRemainder = 26
lAlpha = lAlpha - 1
End If
ColumnNumberToLetter = ColumnNumberToLetter(lAlpha) & Chr(lRemainder + 64)
End If
End Function
Just one more way to do this. Brettdj's answer made me think of this, but if you use this method you don't have to use a variant array, you can go directly to a string.
ColLtr = Cells(1, ColNum).Address(True, False)
ColLtr = Replace(ColLtr, "$1", "")
or can make it a little more compact with this
ColLtr = Replace(Cells(1, ColNum).Address(True, False), "$1", "")
Notice this does depend on you referencing row 1 in the cells object.
This is a version of robartsd's answer (with the flavor of Jan Wijninckx's one line solution), using recursion instead of a loop.
Public Function ColumnLetter(Column As Integer) As String
If Column < 1 Then Exit Function
ColumnLetter = ColumnLetter(Int((Column - 1) / 26)) & Chr(((Column - 1) Mod 26) + Asc("A"))
End Function
I've tested this with the following inputs:
1 => "A"
26 => "Z"
27 => "AA"
51 => "AY"
702 => "ZZ"
703 => "AAA"
-1 => ""
-234=> ""
This is available through using a formula:
=SUBSTITUTE(ADDRESS(1,COLUMN(),4),"1","")
and so also can be written as a VBA function as requested:
Function ColName(colNum As Integer) As String
ColName = Split(Worksheets(1).Cells(1, colNum).Address, "$")(1)
End Function
robertsd's code is elegant, yet to make it future-proof, change the declaration of n to type long
In case you want a formula to avoid macro's, here is something that works up to column 702 inclusive
=IF(A1>26,CHAR(INT((A1-1)/26)+64),"")&CHAR(MOD(A1-1,26)+65)
where A1 is the cell containing the column number to be converted to letters.
LATEST UPDATE: Please ignore the function below, #SurasinTancharoen managed to alert me that it is broken at n = 53.
For those who are interested, here are other broken values just below n = 200:
Please use #brettdj function for all your needs. It even works for Microsoft Excel latest maximum number of columns limit: 16384 should gives XFD
END OF UPDATE
The function below is provided by Microsoft:
Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function
Source: How to convert Excel column numbers into alphabetical characters
APPLIES TO
Microsoft Office Excel 2007
Microsoft Excel 2002 Standard Edition
Microsoft Excel 2000 Standard Edition
Microsoft Excel 97 Standard Edition
This is a function based on #DamienFennelly's answer above. If you give me a thumbs up, give him a thumbs up too! :P
Function outColLetterFromNumber(iCol as Integer) as String
sAddr = Cells(1, iCol).Address
aSplit = Split(sAddr, "$")
outColLetterFromNumber = aSplit(1)
End Function
There is a very simple way using Excel power: Use Range.Cells.Address property, this way:
strCol = Cells(1, lngRow).Address(xlRowRelative, xlColRelative)
This will return the address of the desired column on row 1. Take it of the 1:
strCol = Left(strCol, len(strCol) - 1)
Note that it so fast and powerful that you can return column addresses that even exists!
Substitute lngRow for the desired column number using Selection.Column property!
Here is a simple one liner that can be used.
ColumnLetter = Mid(Cells(Row, LastColA).Address, 2, 1)
It will only work for a 1 letter column designation, but it is nice for simple cases. If you need it to work for exclusively 2 letter designations, then you could use the following:
ColumnLetter = Mid(Cells(Row, LastColA).Address, 2, 2)
This will work regardless of what column inside your one code line for cell thats located in row X, in column Y:
Mid(Cells(X,Y).Address, 2, instr(2,Cells(X,Y).Address,"$")-2)
If you have a cell with unique defined name "Cellname":
Mid(Cells(1,val(range("Cellname").Column)).Address, 2, instr(2,Cells(1,val(range("Cellname").Column)).Address,"$")-2)
So I'm late to the party here, but I want to contribute another answer that no one else has addressed yet that doesn't involve arrays. You can do it with simple string manipulation.
Function ColLetter(Col_Index As Long) As String
Dim ColumnLetter As String
'Prevent errors; if you get back a number when expecting a letter,
' you know you did something wrong.
If Col_Index <= 0 Or Col_Index >= 16384 Then
ColLetter = 0
Exit Function
End If
ColumnLetter = ThisWorkbook.Sheets(1).Cells(1, Col_Index).Address 'Address in $A$1 format
ColumnLetter = Mid(ColumnLetter, 2, InStr(2, ColumnLetter, "$") - 2) 'Extracts just the letter
ColLetter = ColumnLetter
End Sub
After you have the input in the format $A$1, use the Mid function, start at position 2 to account for the first $, then you find where the second $ appears in the string using InStr, and then subtract 2 off to account for that starting position.
This gives you the benefit of being adaptable for the whole range of possible columns. Therefore, ColLetter(1) gives back "A", and ColLetter(16384) gives back "XFD", which is the last possible column for my Excel version.
Easy way to get the column name
Sub column()
cell=cells(1,1)
column = Replace(cell.Address(False, False), cell.Row, "")
msgbox column
End Sub
I hope it helps =)
The solution from brettdj works fantastically, but if you are coming across this as a potential solution for the same reason I was, I thought that I would offer my alternative solution.
The problem I was having was scrolling to a specific column based on the output of a MATCH() function. Instead of converting the column number to its column letter parallel, I chose to temporarily toggle the reference style from A1 to R1C1. This way I could just scroll to the column number without having to muck with a VBA function. To easily toggle between the two reference styles, you can use this VBA code:
Sub toggle_reference_style()
If Application.ReferenceStyle = xlR1C1 Then
Application.ReferenceStyle = xlA1
Else
Application.ReferenceStyle = xlR1C1
End If
End Sub
Furthering on brettdj answer, here is to make the input of column number optional. If the column number input is omitted, the function returns the column letter of the cell that calls to the function. I know this can also be achieved using merely ColumnLetter(COLUMN()), but i thought it'd be nice if it can cleverly understand so.
Public Function ColumnLetter(Optional ColumnNumber As Long = 0) As String
If ColumnNumber = 0 Then
ColumnLetter = Split(Application.Caller.Address(True, False, xlA1), "$")(0)
Else
ColumnLetter = Split(Cells(1, ColumnNumber).Address(True, False, xlA1), "$")(0)
End If
End Function
The trade off of this function is that it would be very very slightly slower than brettdj's answer because of the IF test. But this could be felt if the function is repeatedly used for very large amount of times.
Here is a late answer, just for simplistic approach using Int() and If in case of 1-3 character columns:
Function outColLetterFromNumber(i As Integer) As String
If i < 27 Then 'one-letter
col = Chr(64 + i)
ElseIf i < 677 Then 'two-letter
col = Chr(64 + Int(i / 26)) & Chr(64 + i - (Int(i / 26) * 26))
Else 'three-letter
col = Chr(64 + Int(i / 676)) & Chr(64 + Int(i - Int(i / 676) * 676) / 26)) & Chr(64 + i - (Int(i - Int(i / 676) * 676) / 26) * 26))
End If
outColLetterFromNumber = col
End Function
Function fColLetter(iCol As Integer) As String
On Error GoTo errLabel
fColLetter = Split(Columns(lngCol).Address(, False), ":")(1)
Exit Function
errLabel:
fColLetter = "%ERR%"
End Function
Here, a simple function in Pascal (Delphi).
function GetColLetterFromNum(Sheet : Variant; Col : Integer) : String;
begin
Result := Sheet.Columns[Col].Address; // from Col=100 --> '$CV:$CV'
Result := Copy(Result, 2, Pos(':', Result) - 2);
end;
This formula will give the column based on a range (i.e., A1), where range is a single cell. If a multi-cell range is given it will return the top-left cell. Note, both cell references must be the same:
MID(CELL("address",A1),2,SEARCH("$",CELL("address",A1),2)-2)
How it works:
CELL("property","range") returns a specific value of the range depending on the property used. In this case the cell address.
The address property returns a value $[col]$[row], i.e. A1 -> $A$1.
The MID function parses out the column value between the $ symbols.
Sub GiveAddress()
Dim Chara As String
Chara = ""
Dim Num As Integer
Dim ColNum As Long
ColNum = InputBox("Input the column number")
Do
If ColNum < 27 Then
Chara = Chr(ColNum + 64) & Chara
Exit Do
Else
Num = ColNum / 26
If (Num * 26) > ColNum Then Num = Num - 1
If (Num * 26) = ColNum Then Num = ((ColNum - 1) / 26) - 1
Chara = Chr((ColNum - (26 * Num)) + 64) & Chara
ColNum = Num
End If
Loop
MsgBox "Address is '" & Chara & "'."
End Sub
Column letter from column number can be extracted using formula by following steps
1. Calculate the column address using ADDRESS formula
2. Extract the column letter using MID and FIND function
Example:
1. ADDRESS(1000,1000,1)
results $ALL$1000
2. =MID(F15,2,FIND("$",F15,2)-2)
results ALL asuming F15 contains result of step 1
In one go we can write
MID(ADDRESS(1000,1000,1),2,FIND("$",ADDRESS(1000,1000,1),2)-2)
this is only for REFEDIT ... generaly use uphere code
shortly version... easy to be read and understood /
it use poz of $
Private Sub RefEdit1_Change()
Me.Label1.Caption = NOtoLETTER(RefEdit1.Value) ' you may assign to a variable var=....'
End Sub
Function NOtoLETTER(REFedit)
Dim First As Long, Second As Long
First = InStr(REFedit, "$") 'first poz of $
Second = InStr(First + 1, REFedit, "$") 'second poz of $
NOtoLETTER = Mid(REFedit, First + 1, Second - First - 1) 'extract COLUMN LETTER
End Function
Cap A is 65 so:
MsgBox Chr(ActiveCell.Column + 64)
Found in: http://www.vbaexpress.com/forum/showthread.php?6103-Solved-get-column-letter
what about just converting to the ascii number and using Chr() to convert back to a letter?
col_letter = Chr(Selection.Column + 96)
Here's another way:
{
Sub find_test2()
alpha_col = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,W,Z"
MsgBox Split(alpha_col, ",")(ActiveCell.Column - 1)
End Sub
}
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?