I can't reference a range with a sheet for my function like I can with =vlookup.
This works: =MVLOOKUP(a2,B:C,2,",",", ")
This isn't: =MVLOOKUP(a2,Sheet3!B:C,2,",",", ")
The code:
Public Function MVLookup(Lookup_Values, Table_Array As Range, Col_Index_Num As Long, Input_Separator As String, Output_Separator As String) As String
Dim in0, out0, i
in0 = Split(Lookup_Values, Input_Separator)
ReDim out0(UBound(in0, 1))
For i = LBound(in0, 1) To UBound(in0, 1)
out0(i) = Application.WorksheetFunction.VLookup(in0(i), Table_Array, Col_Index_Num, False)
Next i
MVLookup = Join(out0, Output_Separator)
End Function
I don't know basic and I'm not planning to learn it, I rarely even use excel, so sorry for the lame question. I guess basic is really "basic" it took me 30 minutes to get to this point from the reference(reading included), but other 60 minutes in frustration because the above problem.
Help me so I can go back to my vba free life!
EDIT: Although the code above worked after an excel restart, Jeeped gave me a safer solution and more universal functionality. Thanks for that.
I was not planning to use it on other than strings but thanks for the addition, I wrongly assumed there is a check for data type every time and type passed along in the background and vlookup acting accordingly. I have also learned how to set default values to function input variables.
See solution.
Thanks again, Jeeped!
You are confusing 1 with "1" and regardless of your personal distaste for VBA, I really don't know of any programming language that treats them as identical values (with the possible exception of a worksheet's COUNTIF function).
Public Function MVLookup(Lookup_Values, table_Array As Range, col_Index_Num As Long, _
Optional Input_Separator As String = ",", _
Optional output_Separator As String = ", ") As String
Dim in0 As Variant, out0 As Variant, i As Long
in0 = Split(Lookup_Values, Input_Separator)
ReDim out0(UBound(in0))
For i = LBound(in0) To UBound(in0)
If IsNumeric(in0(i)) Then
If Not IsError(Application.Match(Val(in0(i)), Application.Index(table_Array, 0, 1), 0)) Then _
out0(i) = Application.VLookup(Val(in0(i)), table_Array, col_Index_Num, False)
Else
If Not IsError(Application.Match(in0(i), Application.Index(table_Array, 0, 1), 0)) Then _
out0(i) = Application.VLookup(in0(i), table_Array, col_Index_Num, False)
End If
Next i
MVLookup = Join(out0, output_Separator)
End Function
When you Split a string into a variant array, you end up with an array of string elements. Granted, they look like numbers but they are not true numbers; merely textual representational facsimiles of true numbers. The VLOOKUP function does not treat them as numbers when the first column in your table_array parameter is filled with true numbers.
The IsNumeric function can reconize a string that looks like a number and then the Val function can convert that text-that-looks-like-a-number into a true number.
I've also added a quick check to ensure what you are looking for is actually there before you attempt to stuff the return value into an array.
Your split strings are one-dimensioned variant arrays. There is no need to supply the rank in the LBound / UBound functions.
Sample data on Sheet3 Results from MVLOOKUP
This is not a valid range reference ANYWHERE in Excel B:Sheet3!C.
Either use B:C or Sheet3!B:C
Edit. Corrected as per Jeeped's comment.
Related
I'm working on a piece of code to extract the nominal size of a pipeline from it's tagname. For example: L-P-50-00XX-0000-000. The 50 would be it's nominal size (2") which I would like to extract. I know I could do it like this:
TagnameArray() = Split("L-P-50-00XX-0000-000", "-")
DNSize = TagnameArray(2)
But I would like it to be a function because it's a small part of my whole macro and I don't need it for all the plants I'm working on just this one. My current code is:
Sub WBDA_XXX()
Dim a As Range, b As Range
Dim TagnameArray() As String
Dim DNMaat As String
Dim DN As String
Set a = Selection
For Each b In a.Rows
IntRow = b.Row
TagnameArray() = Split(Cells(IntRow, 2).Value, "-")
DN = DNMaat(IntRow, TagnameArray())
Cells(IntRow, 3).Value = DN
Next b
End Sub
Function DNMaat(IntRow As Integer, TagnameArray() As String) As Integer
For i = LBound(TagnameArray()) To UBound(TagnameArray())
If IsNumeric(TagnameArray(i)) = True Then
DNMaat = TagnameArray(i)
Exit For
End If
Next i
End Function
However this code gives me a matrix expected error which I don't know how to resolve. I would also like to use the nominal size in further calculations so it will have to be converted to an integer after extracting it from the tagname. Does anyone see where I made a mistake in my code?
This is easy enough to do with a split, and a little help from the 'Like' evaluation.
A bit of background on 'Like' - It will return TRUE or FALSE based on whether an input variable matches a given pattern. In the pattern [A-Z] means it can be any uppercase letter between A and Z, and # means any number.
The code:
' Function declared to return variant strictly for returning a Null string or a Long
Public Function PipeSize(ByVal TagName As String) As Variant
' If TagName doesn't meet the tag formatting requirements, return a null string
If Not TagName Like "[A-Z]-[A-Z]-##-##[A-Z]-####-###" Then
PipeSize = vbNullString
Exit Function
End If
' This will hold our split pipecodes
Dim PipeCodes As Variant
PipeCodes = Split(TagName, "-")
' Return the code in position 2 (Split returns a 0 based array by default)
PipeSize = PipeCodes(2)
End Function
You will want to consider changing the return type of the function depending on your needs. It will return a null string if the input tag doesnt match the pattern, otherwise it returns a long (number). You can change it to return a string if needed, or you can write a second function to interpret the number to it's length.
Here's a refactored version of your code that finds just the first numeric tag. I cleaned up your code a bit, and I think I found the bug as well. You were declaring DNMAAT as a String but also calling it as a Function. This was likely causing your Array expected error.
Here's the code:
' Don't use underscores '_' in names. These hold special value in VBA.
Sub WBDAXXX()
Dim a As Range, b As Range
Dim IntRow As Long
Set a = Selection
For Each b In a.Rows
IntRow = b.Row
' No need to a middleman here. I directly pass the split values
' since the middleman was only used for the function. Same goes for cutting DN.
' Also, be sure to qualify these 'Cells' ranges. Relying on implicit
' Activesheet is dangerous and unpredictable.
Cells(IntRow, 3).value = DNMaat(Split(Cells(IntRow, 2).value, "-"))
Next b
End Sub
' By telling the function to expect a normal variant, we can input any
' value we like. This can be dangerous if you dont anticipate the errors
' caused by Variants. Thus, I check for Arrayness on the first line and
' exit the function if an input value will cause an issue.
Function DNMaat(TagnameArray As Variant) As Long
If Not IsArray(TagnameArray) Then Exit Function
Dim i As Long
For i = LBound(TagnameArray) To UBound(TagnameArray)
If IsNumeric(TagnameArray(i)) = True Then
DNMaat = TagnameArray(i)
Exit Function
End If
Next i
End Function
The error matrix expected is thrown by the compiler because you have defined DNMaat twice: Once as string variable and once as a function. Remove the definition as variable.
Another thing: Your function will return an integer, but you assigning it to a string (and this string is used just to write the result into a cell). Get rid of the variable DN and assign it directly:
Cells(IntRow, 3).Value = DNMaat(IntRow, TagnameArray())
Plus the global advice to use option explicit to enforce definition of all used variables and to define a variable holding a row/column number always as long and not as integer
I'm reluctant to ask questions about UDF's designed to write to other cells since, by design, this behavior is supposed to be disabled. But... I'm going to power through all the potential criticisms and ask anyway. I don't really expect to have this answered completely, so I'm just fishing for any insight into the odd behavior I'm encountering.
I have a UDF that is designed to calculate a simple bearing allowable. It takes 10 parameters. If any of the parameters are out-of-range the UDF will return "Error" in the calling cell. I wanted to one-up this rather useless feedback by listing all the offending inputs so that the user doesn't have to make a single correction one after the other. This way all the bad inputs would be listed and the user can correct all the inputs at once. FYI, there are more than 10 potential issues with the inputs due to some of the input interactions. Otherwise the user could try massaging the inputs dozens of times without success. This is why I wanted to list all the feedback at once.
The UDF: Shorthand - it sends the data to Class Module to perform all the checks and calculations.
public Function LBA(ByVal layup_string As String, ByVal diaBolt As Double, ByVal boltHead As String, _
ByVal eD As Double, ByVal tMetallicFitting As Double, ByVal tempF As Double, ByVal depth As Double, _
ByVal allowable_type As String, ByVal basis As String, ByVal cond As String) As Variant
'
' declare variables
Dim s As String
Dim val As Variant
Dim clba As New cFunc_LBA
'
' send to class constructor
clba.init layup_string, diaBolt, boltHead, eD, tMetallicFitting, tempF, depth, allowable_type, basis, cond
'
' get errors
If clba.contains_errs Then ' ............................... check for design space violattions: errors
s = clba.get_errs ' .................................... get concat string of all errors
Evaluate ("post_error_messages(""" & s & """)") ' ...... run the subroutine to post err msgs
val = "Error" ' ........................................ return value to calling cell
'
Else
'
' return a valid bearing allowable
val = clba.LBA ' ....................................... expose bearing allowable property
'
End If
'
LBA = val
End Function
The Class Module works as expected. All the calcs and error logs work. In the UDF when I check if there were errors, it returns the errors. I then send the errors (in one long concatenated string) to another subroutine that is supposed to output the errors into other worksheet cells.
The Sub:
Private Sub post_error_messages(ByVal s As String)
' declare variables
Dim arr As Variant
'
' initialize variables
arr = Split(s, ",")
'
' post error messages
For i = 0 To UBound(arr) ' .................. loop thru error messages
m.Cells(17 + i, 2) = CStr(arr(i)) ' ..... write msg in cell, increment by ROW#
Next i
End Sub
A quirk I noticed along the way... I could only get the subroutine (called by Evaluate) to accept a single parameter. Also I could only get it to accept a simple data-type string. I tried arrays, variants, scripting.dictionary none of which worked. Hence all my error messages where concatenated into one long string then split and looped over in the sub.
My problem now is that this setup is only sort of working.
Problem 1: Regardless of how many errors are returned the Sub to post error messages will only return three items. In fact it always returns three items, even if there are only two (the last one shown gets repeated). If there are 10 error messages - 3 get shown. I put debug.print statements in my error message sub so I could see what was happening and it shows that when ONLY 2 error messages are returned it should only be printing to 2 cells, but it prints to the third cell anyway. More than 3 errors just get dropped.
Problem 2: If I delete the cells in the sheet showing the error messages and execute the UDF again the messages will NOT come back. Only if I close the workbook and open it again will the error message subroutine print to the cells again (from the UDF).
Also, and this is not really a problem, Evaluate runs twice. I've looked this up and it seems to be a known issue. I'm just putting this out there, but I'm not sure this causes any issues.
Again, since I'm working outside the intended functionality of Excel's UDFs I do not expect a solution. That said, can anybody offer any insight on this?
Not an answer to your question, but this stripped-down version works OK for me:
Public Function LBA() As Variant
Dim val, s
s = "A,B,C,D,E"
Evaluate "post_error_messages(""" & s & """)"
val = "Error" '
LBA = val
End Function
Private Sub post_error_messages(s As String)
Dim arr As Variant, i
With Sheet1.Cells(17, 2)
.Resize(10, 1).Value = "" '<<< clear any previous errors!
arr = Split(s, ",")
.Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr)
End With
End Sub
I'm writing some VBA functions in Excel that compute word values and cross sums of the input.
I'm passing the input as Public Function cross_sum(myRange As Range) As Integer to them so that they take cell references as input, e.g. =cross_sum(A1). Works fine.
However when I try to chain two functions like =cross_sum(word_value(A1)) I run into th VALUE error because word_value() returns an Integer value and not the Range cross_sum() is set to expect. However I did not find a way to cast an Integer (or String) into a Range.
As Excel's built-in functions support chaining as well as Range input I wonder how.
Unfortunately this is my first VBA project so I wonder if and how to cast or what type to choose to get this working both ways.
Any pointers appreciated!
TIA,
JBQ
You can pass Variant to a function and the function can determine the type of input:
Public Function Inputs(v As Variant) As String
If TypeName(v) = "Range" Then
MsgBox "you gave me a range"
Else
MsgBox "you gave me a string"
End If
Inputs = "done"
End Function
Sub MAIN()
Dim st As String
Dim rng As Range
st = "A1"
Set rng = Range(st)
x = Inputs(st)
x = Inputs(rng)
End Sub
Without your code, it is hard to know what you could change. That being said...
There is not a way to convert an integer to a range. You would have to create a function to do so if that is what you desired.
You could create a converter function, maybe titled IntegerToRange, that takes an integer and after some logic (maybe 1 = "A1", 2 = "A2" or something), will return a range. Your cell formula would then be =cross_sum(IntegerToRange(word_value(A1))
Alternatively, you could modify your word_value function to return a range instead of an integer. Your cell formula would then be =cross_sum(word_value(A1).
If I had a column like this:
Col1
abc
def
ghi
jkl
How can I convert it to a string like this?:
"abc,def,ghi,jkl"
You can use the Join() function to join all the elements of a 1 dimensional array with a delimiter.
The Transpose() function is used below to form the dimensional array (this approach works on a single column or row).
Sub Main()
Dim arr
arr = Join(Application.Transpose(Range("A2:A5").Value), ",")
MsgBox arr
End Sub
or as a UDF
Public Function Merge(r As Range) As String
Merge = Join(Application.Transpose(r.Value), ",")
End Function
Just in case you need heavier machinery use one of the solutions provided in the answer below. I had similar challenge for ranges containing milion of cells. In such cases JOIN will lead to crash.
Check the question here:
Turn Excel range into VBA string
I have tested all the approaches provided in the above link. Solutions based on function JOIN have slow performance, or even lead to crash.
Ordinary loop through all the cells is way faster than JOIN function. The sting builder in accepted answer is even faster. With string builder, the strings consisting of millions of cells are build in seconds. This is the solution I have end up with.
Double-transpose works for doing string join on single-row values. Thanks #user2140173 and #brettdj!
debug.print join(Application.Transpose(Application.Transpose(Range("A1:G1").Value)),",")
Public Function COLSASLIST(Rng As Range) As String
Dim tempStr1 As String
tempStr1 = Replace(Replace(Join(Application.Transpose(Application.Transpose(Rng.Value)), ","), ",,", ""), ",,", ",")
If Right(tempStr1, 1) = "," Then tempStr1 = Left(tempStr1, Len(tempStr1) - 1)
COLSASLIST = tempStr1
End Function
Public Function ROWSASLIST(Rng As Range) As String
Dim tempStr1 As String
tempStr1 = Replace(Replace(Join(Application.Transpose(Rng.Value), ","), ",,", ","), ",,", ",")
If Right(tempStr1, 1) = "," Then tempStr1 = Left(tempStr1, Len(tempStr1) - 1)
ROWSASLIST = tempStr1
End Function
Using the new dynamic worksheetfunction TextJoin() of Microsoft 365/Excel2019 (+/-Mac) and Excel for the Web you can build a udf with the following range arguments
(1) a column or
(2) a row or even
(3) a contiguous range input (e.g. "A2:C5")
The optional 2nd argument ExcludeBlanks allows to omit blank values.
The function result is a comma separated list (important for case (3): the reading order is row wise).
Function Rng2List(rng As Range, Optional ExcludeBlanks As Boolean = True) As String
Rng2List = WorksheetFunction.TextJoin(",", ExcludeBlanks, rng)
End Function
See help at Textjoin function
VBA for Access lacks a simple Max(x,y) function to find the mathematical maximum of two or more values. I'm accustomed to having such a function already in the base API coming from other languages such as perl/php/ruby/python etc.
I know it can be done: IIf(x > y, x,y). Are there any other solutions available?
I'll interpret the question to read:
How does one implement a function in Access that returns the Max/Min of an array of numbers? Here's the code I use (named "iMax" by analogy with IIf, i.e., "Immediate If"/"Immediate Max"):
Public Function iMax(ParamArray p()) As Variant
' Idea from Trevor Best in Usenet MessageID rib5dv45ko62adf2v0d1cot4kiu5t8mbdp#4ax.com
Dim i As Long
Dim v As Variant
v = p(LBound(p))
For i = LBound(p) + 1 To UBound(p)
If v < p(i) Then
v = p(i)
End If
Next
iMax = v
End Function
Public Function iMin(ParamArray p()) As Variant
' Idea from Trevor Best in Usenet MessageID rib5dv45ko62adf2v0d1cot4kiu5t8mbdp#4ax.com
Dim i As Long
Dim v As Variant
v = p(LBound(p))
For i = LBound(p) + 1 To UBound(p)
If v > p(i) Then
v = p(i)
End If
Next
iMin = v
End Function
As to why Access wouldn't implement it, it's not a very common thing to need, seems to me. It's not very "databasy", either. You've already got all the functions you need for finding Max/Min across domain and in sets of rows. It's also not very hard to implement, or to just code as a one-time comparison when you need it.
Maybe the above will help somebody.
Calling Excel VBA Functions from MS Access VBA
If you add a reference to Excel (Tools → References → Microsoft Excel x.xx Object Library) then you can use WorksheetFunction to call most Excel worksheet functions, including MAX (which can also be used on arrays).
Examples:
MsgBox WorksheetFunction.Max(42, 1999, 888)
or,
Dim arr(1 To 3) As Long
arr(1) = 42
arr(2) = 1999
arr(3) = 888
MsgBox WorksheetFunction.Max(arr)
The first call takes a second to respond (actually 1.1sec for me), but subsequent calls are much more reasonable (<0.002sec each for me).
Referring to Excel as an object
If you're using a lot of Excel functions in your procedure, you may be able to improve performance further by using an Application object to refer directly to Excel.
For example, this procedure iterates a set of records, repeatedly using Excel's MAX on a Byte Array to determine the "highest" ASCII character of each record.
Option Compare Text
Option Explicit
'requires reference to "Microsoft Excel x.xx Object Library"
Public excel As New excel.Application
Sub demo_ListMaxChars()
'list the character with the highest ASCII code for each of the first 100 records
Dim rs As Recordset, mx
Set rs = CurrentDb.OpenRecordset("select myField from tblMyTable")
With rs
.MoveFirst
Do
mx = maxChar(!myField)
Debug.Print !myField, mx & "(" & ChrW(mx) & ")" '(Hit CTRL+G to view)
.MoveNext
Loop Until .EOF
.Close
End With
Set rs = Nothing 'always clean up your objects when finished with them!
Set excel = Nothing
End Sub
Function maxChar(st As String)
Dim b() As Byte 'declare Byte Array
ReDim b(1 To Len(st)) 'resize Byte Array
b = StrConv(st, vbFromUnicode) 'convert String to Bytes
maxChar = excel.WorksheetFunction.Max(b) 'find maximum Byte (with Excel function)
End Function
Because they probably thought that you would use DMAX and DMIN or the sql MAX and only working with the database in access?
Im also curious about why.. Its seems like a overkill to have to create a temp-table and add form values to the table and then run a DMAX or MAX-query on the table to get the result...
I've been known to create a small projMax() function just to deal with these. Not that VBA will probably ever be enhanced, but just in case they ever do add a proper Max (and Min) function, it won't conflict with my functions. BTW, the original poster suggests doing IIF... That works, but in my function, I usually throw a couple of Nz()'s to prevent a null from ruining the function.
Both functions have problems with Null. I think this will be better.
Public Function iMin(ParamArray p()) As Variant
Dim vVal As Variant, vMinVal As Variant
vMinVal = Null
For Each vVal In p
If Not IsNull(vVal) And (IsNull(vMinVal) Or (vVal < vMinVal)) Then _
vMinVal = vVal
Next
iMin = vMinVal
End Function
I liked DGM's use of the IIF statement and David's use of the For/Next loop, so I am combining them together.
Because VBA in access does not have a strict type checking, I will be using varients to preserve all numerics, integer and decimal, and re-type the return value.
Kudos to HansUP for catching my parameter verification :)
Comments added to make code more friendlier.
Option Compare Database
Option Base 0
Option Explicit
Function f_var_Min(ParamArray NumericItems()) As Variant
If UBound(NumericItems) = -1 Then Exit Function ' No parameters
Dim vVal As Variant, vNumeric As Variant
vVal = NumericItems(0)
For Each vNumeric In NumericItems
vVal = IIf(vNumeric < vVal, vNumeric, vVal) ' Keep smaller of 2 values
Next
f_var_Min = vVal ' Return final value
End Function
Function f_var_Max(ParamArray NumericItems()) As Variant
If UBound(NumericItems) = -1 Then Exit Function ' No parameters
Dim vVal As Variant, vNumeric As Variant
vVal = NumericItems(0)
For Each vNumeric In NumericItems
vVal = IIf(vNumeric < vVal, vVal, vNumeric) ' Keep larger of 2 values
Next
f_var_Max = vVal ' Return final value
End Function
The only difference between the 2 functions is the order of vVal and vNumeric in the IIF statement.The for each clause uses internal VBA logic to handle the looping and array bounds checking, while "Base 0" starts the array index at 0.
You can call Excel functions in Access VBA:
Global gObjExcel As Excel.Application
Public Sub initXL()
Set gObjExcel = New Excel.Application
End Sub
Public Sub killXL()
gObjExcel.Quit
Set gObjExcel = Nothing
End Sub
Public Function xlMax(a As Double, b As Double) As Double
xlCeiling = gObjExcel.Application.Max(a, b)
End Function
You can do Worksheetfunction.max() or worksheetfunction.min() within Access VBA. Hope this helps.