I'm trying to use Application.Caller inside a Function (code below), but Excel returns a #VALUE and the background color is not set.
The personal function is called from an Excel cell. The idea is to map RGB values to color display in a "synchronous" fashion (i.e. without having to press a button).
When I run the following function through the debugger and step just before the instruction vCaller.Interior.Color = RGB(rlev, glev, blev), I can manually set the background color to green by pasting the exact same instruction in the execution console. So I'm puzzled as to why Excel is failing but VBA isn't.
Any clue ?
Public Function RGB_print(rlev As Integer, glev As Integer, blev As Integer)
As String
Dim vCaller As Variant
Set vCaller = Application.Caller
If TypeName(vCaller) = "Range" Then
vCaller.Interior.Color = RGB(rlev, glev, blev)
End If
RGB_print = ""
End Function
I completely agree with the comment from #Rory - I'd never use this code in my own projects, but I wanted to see anyway....
If in a normal module you create this function:
Public Function RGB_print(rlev As Integer, glev As Integer, blev As Integer)
Application.Volatile
End Function
Then in your sheet add this code:
Private Sub Worksheet_Calculate()
Dim rFormula As Range
Dim vForm As Variant
Dim sArguments As String
Dim sFormula As String
Dim rgblev As Variant
Set rFormula = Sheet1.Cells.SpecialCells(xlCellTypeFormulas)
For Each vForm In rFormula
If InStr(vForm.FormulaLocal, "RGB_print") <> 0 Then
sFormula = vForm.FormulaLocal
sArguments = Mid(sFormula, InStr(sFormula, "(") + 1, InStr(sFormula, ")") - InStr(sFormula, "(") - 1)
rgblev = Split(sArguments, ",")
vForm.Interior.Color = RGB(Evaluate(rgblev(0)), Evaluate(rgblev(1)), Evaluate(rgblev(2)))
End If
Next vForm
End Sub
This worked for formula such as:
=RGB_print(255,0,255) and =RGB_print(A5,B5,C5)
But again, find another way - this code has so many pitfalls I'll probably lose 100 reputation just for posting it.
Ok, as an alternative to Darrent's very precise reply, I'm reposting Tim Williwam's comment : whether one may/should mix functions and macros is an important question and it has been discussed here. Bottom line is : you can but don't do it unless you know what you are doing and are prepared to face the consequences.
Related
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.
I have a macro (code attached) which writes the data from two sheets into two variant arrays. It then uses a nested loop to look for all possible matches in the 2nd sheet on a piece of data in the 1st sheet.
When the first match is found one of the variant arrays appears to get wiped and I get a 'Subscript out of range'. this can happen when the data is being compared or when I subsequently try to pass data from that array to another procedure as a result of a match being found.
When I look in the Locals window, this array can change from showing the stored values to having the error message "Application-defined or object-defined error" in each index, or no indexes at all, or indexes with high negative numbers.
Regardless, if I try to investigate further while the code is in debug mode, Excel crashes ("Excel has encountered a problem and needs to close").
I have followed the advice at this link:
http://exceleratorbi.com.au/excel-keeps-crashing-check-your-vba-code/
...but to no avail.
I've stepped through the code and can trace it to the first time the data values being tested match. It happens for the same indexes (same i and j values) every time I run.
I'm using Excel 2013 on our office network.
Can anyone tell me what might be causing this or any tests I could perform to help narrow down the cause?
Could it be due to memory use? The arrays come out at about 15000 x 11 and 4000 x 6 and it's the smaller one that is being corrupted/failing.
Sub classTest()
Dim i As Long, j As Long
Dim CK_Array() As Variant, RL_Array() As Variant
Dim wb As Workbook
Dim CK_Data As Worksheet, RL_Data As Worksheet
Set wb = ThisWorkbook
Set CK_Data = wb.Sheets(1)
Set RL_Data = wb.Sheets(2)
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data) ' this sets the array that gets corrupted.
For i = 2 To UBound(CK_Array)
If Not IsEmpty(CK_Array(i, 6)) Then
For j = 2 To UBound(RL_Array)
If CK_Array(i, 6) = RL_Array(j, 4) Then ' array gets corrupted here or line below
Call matchFound(dResults, CStr(CK_Array(i, 1) & " | " & CK_Array(i, 5)), CStr(RL_Array(j, 2) & " " & RL_Array(j, 3)), CStr(RL_Array(j, 1)), CStr(RL_Array(1, 3))) ' or array gets corrupted here
End If
Next j
End If
Next i
End Sub
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
Dim endR As Long, endC As Long
Dim rng As Range
endR = ws.UsedRange.Rows.Count
endC = ws.UsedRange.Columns.Count
Set rng = Range(ws.Cells(1, 1), ws.Cells(endR, endC))
arr = rng
End Sub
EDIT:
As requested here is the code to the matchfound Sub. It's a dictionary, which holds class objects in a collection. Therefore I have also posted the class code below. I'm not yet making use of all of the class properties and methods as this issue has halted my testing.
Sub matchFound(dictionary As Object, nameCK As String, nameRL As String, RLID As String, dataitem As String)
Dim cPeople As Collection
Dim matchResult As CmatchPerson
If dictionary.exists(nameCK) Then
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
dictionary.Item(nameCK).Add matchResult
Else
Set cPeople = New Collection
Set matchResult = New CmatchPerson
matchResult.Name = nameRL
matchResult.RLID = RLID
matchResult.matchedOn = dataitem
cPeople.Add matchResult
dictionary.Add nameCK, cPeople
End If
End Sub
Class
Option Explicit
Private pName As String
Private pRLID As String
Private pMatchedOn As String
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Name As String)
pName = Name
End Property
Public Property Get RLID() As String
RLID = pRLID
End Property
Public Property Let RLID(ID As String)
pRLID = ID
End Property
Public Property Get matchedOn() As String
matchedOn = pMatchedOn
End Property
Public Property Let matchedOn(textString As String)
pMatchedOn = textString
End Property
Public Sub MatchedOnString(datafield As String)
Dim text As String
text = Me.matchedOn & "|" & datafield
Me.Name = text
End Sub
I've reduced your problem to a Minimum, Verifiable and Complete Example.
The problem occurs when you assign the implicit default value of a range to a Variant variable that was passed as a Variant array.
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
'aFoo() has now lost it's `+` sign in Locals window, but the bounds are still visible
Debug.Print aBar(1, 1)
'aFoo() has now lost its bounds in Locals Window
'aFoo(1,1) will produce subscript out of range
'Exploring the Locals Window, incpsecting variables, will crash Excel
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
'Note the use of theArray instead of theArray()
'Implicitly calling the default member is problematic
theArray = Sheet1.UsedRange
End Sub
There are a number of workarounds - I'd recommend using both:
Use Explicit calls to `Range.Value`
You can even make explicit call to the default member Range.[_Default]. The exact method isn't important, but it must be explicit.
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange.Value
End Sub
Avoid the use of `Call`, and pass common Variant definitions
Call is a deprecated statement, and can be omitted.
Declare the arrays and the helper functions' array argument consistently. That is, use () in all instances, or none.
Note the difference between declaring Dim aFoo() As Variant which is an array of Variants, and declaring Dim aFoo As Variant which is a Variant that can contain an array.
With Parentheses
Sub VariantArrayWTF()
Dim aBar() As Variant
Dim aFoo() As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray() As Variant)
theArray = Sheet1.UsedRange
End Sub
Without Parentheses
Sub VariantArrayWTF()
Dim aBar As Variant
Dim aFoo As Variant
GetArray aBar
GetArray aFoo
Debug.Print aBar(1, 1)
Debug.Print aBar(1, 1)
Debug.Print aFoo(1, 1)
End Sub
Sub GetArray(ByRef theArray As Variant)
theArray = Sheet1.UsedRange
End Sub
I have found the lines of code which were causing the problem. However, I cannot explain why it would necessarily cause a crash so I would appreciate other input on why this is happening.
When passing the RL and CK arrays to the getRange_Build Array sub I left out the brackets that would have denoted these variables as arrays.
The code was this...
Call getRange_BuildArray(CK_Array, CK_Data)
Call getRange_BuildArray(RL_Array, RL_Data)
...but should have been this
Call getRange_BuildArray(CK_Array(), CK_Data)
Call getRange_BuildArray(RL_Array(), RL_Data)
I'm thinking the reason that this didn't get flagged as a compile error is because the parameter in question in the getRange_BuildArray procedure itself also lacked the necessary brackets to denote an array.
It was this...
Private Sub getRange_BuildArray(arr As Variant, ws As Worksheet)
...it should have been this
Private Sub getRange_BuildArray(arr() As Variant, ws As Worksheet)
With those changes in place the macro is completing successfully for the full dataset and is not causing excel to crash.
As mentioned it would be great if someone could offer a more detailed breakdown of how this caused excel to crash.
I have previously used this method within my program to insert a formula which was a lot larger however I am receiving "run-time error code 1004 unable to set the FormulaArray property of the range class" with this one:
Sub TEST()
Dim QFormula As String
Dim QCountF As String
Dim QCountF2 As String
Dim WStart As String
Dim MoreDash As String
Dim ValueF As String
QFormula = "=IF($K3=4,IF(_Q_>0,1,_M_),IF($K3=2,IF(_Q_>0,1,IF(COLUMN(P3)-MATCH(_S_,$A$1:P$1,0)>=8,IF(_Q2_>0,1,_M_),_M_)),IF(_Q_>0,1,IFERROR(IF((COLUMN(P3)-MATCH(_S_,$A$1:P$1,0)+1)-_V_<=13,1,_M_),_M_))))"
QCountF = "COUNTA(OFFSET(INDIRECT(ADDRESS(ROW(P3),COLUMN(P3)-4)),0,1,1,3))"
QCountF2 = "COUNTA(OFFSET(INDIRECT(ADDRESS(ROW(P3),COLUMN(P3)-8)),0,1,1,3))"
WStart = """START"""
MoreDash = """-"""
ValueF = "VALUE(MATCH(1,INDIRECT(ADDRESS(ROW(P3),MATCH(_S_,$A$1:P$1,0))):O3,0))"
With ActiveCell
.FormulaArray = QFormula
.Replace "_Q_", QCountF
.Replace "_Q2_", QCountF2
.Replace "_S_", WStart
.Replace "_M_", MoreDash
.Replace "_V_", ValueF
End With
End Sub
I am at a loss as to where I have gone wrong this time and am hoping you can help.
Thanks in advance
Taken straight from msdn site:
If you use this property to enter an array formula, the formula must use the R1C1 reference style, not the A1 reference style (see the example).
Worksheets("Sheet1").Range("E1:E3").FormulaArray = "=Sum(R1C1:R3C3)"
Update edit:
As you stated in comments even though msdn states you have to use R1C1 reference the A1 reference works too.
The actual issue in your code is:
ValueF = "VALUE(MATCH(1,INDIRECT(ADDRESS(ROW(P3),MATCH(_S_,$A$1:P$1,0))):O3,0))"
you have another _S_ within the replacement code this never gets changed as its already past the _S_ .Replace.
Fix:
ValueF = "VALUE(MATCH(1,INDIRECT(ADDRESS(ROW(P3),MATCH(""START"",$A$1:P$1,0))):O3,0))"
I have an excel sheet with values in a range which I want to perform some calculations on in vb.net. I pass that range to vb.net using COM. When I try editing the values of the range, nothing happens.
My question seems to be very similar to these questions, but I can't quite figure out what step I am missing.
How to edit cell value in VB.net - Using .Interop.Excel
VB.net Office Solution - Accessing value in named Range in a Worksheet
VBA CODE:
Function MyTestRange (Byref myrng as range)
Set classLib = New VBProject.CClass
MyTestRange = classLib.MyTestRange(myrng)
End Function
VB.NET code
Imports Microsoft.Office.Interop.Excel
Public Class CClass
Function MyTestRange(ByRef myrng As Range) As Double
Dim newrng As Range
Dim b As Integer = myrng.Rows.Count
Dim i As Integer
newrng = myrng
For i = 1 To b
newrng.Value2(i, 1) = myrng.Value2(i, 1) + 1
Next i
MyTestRange = newrng.Value2(1, 1)
End Function
End class
While this code doesn't generate an error, it doesn't change the values in newrng.
Edit:
I have tried many iterations based on the link provide, but always get the same error :
An exception of type 'System.Runtime.InteropServices.COMException' occurred in mscorlib.dll but was not handled in user code
Additional information: Exception from HRESULT: 0x800A03EC
This is the simplest way to generate the error:
Dim c As Object
c = myrng.Value
myrng.Value = c
Hence amending the values to something new, seems out of reach!
Edit 2:
After chatting with user Mat's Mug, I tried to edit a value in a range, purely in VBA.
This sub works perfectly:
Sub rangesub()
Dim example As Range
Set example = Range("A1:A4")
example.Value = Application.Transpose(Array(1, 2, 3, 4))
End Sub
Excel functions also seem able to handle passing ranges:
Function SimpleCopyRange(myrng)
SimpleCopyRange = myrng
End Function
A very simple combination of this code works:
Function EditRange(myrng)
Dim example As Range
Set example = Range("A1:A4")
EditRange = example
End Function
However there is an unspecified error if I try to edit the range:
Function EditRange(myrng)
Dim example As Range
Set example = Range("A1:A4")
example.Value = Application.Transpose(Array(1, 2, 3, 4))
EditRange = example
End Function
The application.transpose part obviously adds a layer of complexity, and can be replaced with example.Value = 8 without any changes in results.
Looking at this question/answer:
Excel VBA: Iterating over range parameter and change cell values
It appears that a UDF can only change the calling cell.
I think therefore this method is impossible.
The workaround is to to rewrite the code to work with an array, assign the range to an array, edit the array and pass it to the new 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.