Hoping there is a quick answer to this question....
I have an array and I want to populate it with a list of arguments.
Sub EasyArrayInput()
Dim myArr() as variant
myArr = ("string1", "string2", "string3")
End Sub
I am well aware of how to loop through and populate with a for/next or do/while, but it would be nice to be able to populate an array when the values wont change without using a hardcoded method.
Sub UsualMethodThatIDontWantToDo()
Dim myArr(1 to 3) as variant
myArr(1) = "string1"
myArr(2) = "string2"
myArr(3) = "string3"
End Sub
Is there anyway to do it in a method similar to the first code snippet? I would prefer to do it that way. I apologize if this question has been asked/answered, but I'm not quite sure what the method I am asking about is called.
Thanks in advance!
Edit: Solution
The code snippet below (from the link that chancea sent) will create an array that is a variant and exaclty what I wanted.
Sub EasyArrayInput()
Dim myArr() as variant
myArr = Array("string1", "string2", "string3")
End Sub
The next code snippet looks to be useful for if you only have strings and don't want to initialize a variant:
Sub EasyArrayInput()
Dim myArr() as String
myArr = Split("String1,String2,String3", ",")
End Sub
How about?
Sub EasyArrayInput()
Dim myArr() As Variant
myArr = Array("string1", "string2", "string3")
End Sub
Assuming you have some sort of numeric sequence, you can do something like this:
Dim myArray()
myArray = [TRANSPOSE(INDEX("string"&ROW(1:10),))]
but frankly I think a loop is clearer.
Related
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.
The following code:
Sub mySub()
Dim s As String
s = "jdsjakfjdaskl"
Dim a(Len(s)) As String
End Sub
Gives an error
"Compile error: Constant expression required".
I would really appreciate any advice on how to fix this, thanks!
You have to use ReDim if you wish the size of an array to be set at run-time:
Sub mySub()
Dim s As String
Dim a() As String
s = "jdsjakfjdaskl"
ReDim a(1 To Len(s)) As String
'The "As String" in the above statement is optional as it already knows
'it is of type String, so you can simplify that if you like to:
'ReDim a(1 To Len(s))
End Sub
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.
The following code is intended to inspect the values of Excel cells and return a List(Of Excel.Range) containing only those cells whose values are unique. The line with the question marks is the one causing the pain.
Private Function UniqueValues(ws As Excel.Worksheet) As List(Of Excel.Range)
Dim listRanges As New List(Of Excel.Range)
Dim dicValues As New Dictionary(Of Excel.Range, Object)
For Each rng As Excel.Range In ws.UsedRange
dicValues.Add(rng, rng.Value2)
Next
'Get list of cells with unique values
listRanges = dicValues.Keys.GroupBy(Function(x) x.Value2).ToList '????
dicValues = Nothing
Return listRanges
End Function
What is the correct code for the line with question marks? Please respond in VB.NET, as I have a hard time converting LINQ from C# to VB.NET given the dearth of VB.NET LINQ examples on the Internet.
That should do the Trick:
listRanges = dicValues.Values.Distinct().ToList()
Here is what I ultimately ended up doing, which worked. I believe there is probably a faster way using LINQ that does not require the second loop, so if someone has a more elegant solution, please post it.
Private Function UniqueValues(ws As Excel.Worksheet) As List(Of Excel.Range)
Dim listRanges As New List(Of Excel.Range)
Dim dicValues As New Dictionary(Of Excel.Range, Object)
For Each rng As Excel.Range In ws.UsedRange
dicValues.Add(rng, rng.Value2)
Next
'Get list of cells with unique values
Dim uniqueVals = dicValues.Where(Function(x)
Return dicValues.Where(Function(y) y.Value = x.Value).Count = 1
End Function)
For Each itm In uniqueVals
listRanges.Add(itm.Key)
Next
uniqueVals = Nothing
dicValues = Nothing
Return listRanges
End Function
I hope this isn't a repeat (I looked all over and couldn't find a straight answer - I'm probably missing something obvious).
If it's possible, how is it done? I'm not trying to output to any cells.
Yes. Just put parentheses after the return type in the function.
Here is a simple example function and sub using it:
Sub test3()
Dim myarray() As String
myarray = returnarray()
MsgBox myarray(2)
End Sub
Function returnarray() As String()
returnarray = Split("test1, test2, test3", ",")
End Function