I'm trying to get some data I input with another macro into a 2-dimensional array so I can then apply a function to that data, but no matter what I try I keep getting errors. The data includes strings and numbers. I could always just reference the cells and forget about the array, but that complicates the function. Here's my code:
(Declarations)
Dim nLiens As Byte, nCreditors As Byte
Dim SecurityV As Currency, ASecurityV As Currency
Const adjuster = 0.9
(Relevant subs)
Public Sub VariableDeclaration()
nLiens = InputBox("Enter number of liens in security")
nCreditors = InputBox("Enter number of creditors")
SecurityV = InputBox("Enter security full value")
ASecurityV = adjuster * SecurityV
Call ODebt
End Sub
Sub ODebt()
'
'(...)
'
Dim oDebt() As Variant
ReDim oDebt(1 To nCreditors + 1, 1 To nLiens + 1)
Dim rg As Range
Set rg = Range(Cells(1, 1), Cells(nCreditors + 1, nLiens + 1))
oDebt = rg.Value
MsgBox (oDebt)
'>>> ERROR: type mismatch
Call SAllocation
End Sub
I've tried other alternatives, such as setting the content cell by cell with two 'For' loops and LBound and UBound, but nothing seems to work.
You are getting your error not while filling, but at displaying the array.
It is not possible to just Msgbox an array, since Msgbox expects a String argument. You can, in the other hand, display specific positions (e.g. oDebt(1,1)).
If you want to have a look at all of its contents, either use debug mode and the Local window, or print it to some unused cells.
I would copy the values from the datasheet this way:
Dim oDebt As Variant
Dim rg As Range
Set rg = Range(Cells(1, 1), Cells(nCreditors + 1, nLiens + 1))
oDebt = rg ' get data from sheet
'... do calculations with oDebt array
rg = oDebt ' put data on sheet
In words: you dimension the array automatically by assigning the range. If you need the numeric boundaries, use
nrows = UBound(oDebt, 1)
ncols = UBound(oDebt, 2)
Here you see the meaning of the dimension as well, index 1 is rows, index 2 is columns.
Related
Situation
I have a UDF that works with a range that it is passed that is of variable height and 2 columns wide. The first row will contain text in column 1 and an empty column2. The remainder of column 1 will contain unsorted text with an associated value in the same row in column 2. I need to sort the data such that if some text in column 1 also appears in some other text in column.
Problem
My VBA skills are all self taught and mimimal at best. I remember a few decades ago in university we did bubble sorts and played with pointers, but I no longer remember how we achieved any of that. I do well reading code but creating is another story.
Objective
I need to generate a sort procedure that will produce unique text towards the bottom of the list. I'll try wording this another way. If text in column1 can be found within other text in column, that the original text need to be placed below the other text it can be found in along with its associated data in column 2. The text is case sensitive. Its not an ascending or descending sort.
I am not sure if its a restriction of the UDF or not, but the list does not need to be written back to excel, it just needs to be available for use in my UDF.
What I have
Public Function myFunk(rng As Range) As Variant
Dim x As Integer
Dim Datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
Datarange = rng.Value
'insert something around here to get the list "rng or Datarange" sorted
'maybe up or down a line of code depending on how its being done.
Equation = Datarange(1, 1)
For x = 2 To UBound(Datarange, 1)
VariablesLength = Len(Datarange(x, 1)) - 1
Variable = Left$(Datarange(x, 1), VariablesLength)
Equation = Replace$(Equation, Variable, Datarange(x, 2))
Next x
myFunk = rng.Worksheet.Evaluate(Equation)
End Function
Example Data
Any help with this would be much appreciated. In that last example I should point out that the "=" is not part of the sort. I have a routine that strips that off the end of the string.
So in order to achieve what I was looking for I added a SWAP procedure and changed my code to look like this.
Public Function MyFunk(rng As Range) As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
'convert the selected range into an array
datarange = rng.Value
'verify selected range is of right shape/size
If UBound(datarange, 1) < 3 Or UBound(datarange, 2) <> 2 Then
MyFunk = CVErr(xlErrNA)
Exit Function
End If
'strip the equal sign off the end if its there
For x = 2 To UBound(datarange, 1)
If Right$(datarange(x, 1), 1) = "=" Then
datarange(x, 1) = Left$(datarange(x, 1), Len(datarange(x, 1)) - 1)
End If
Next x
'sort the array so that a variable does not get substituted into another variable
'do a top down swap and repeat? Could have sorted by length apparently.
For x = 2 To UBound(datarange, 1) - 1
For y = x + 1 To UBound(datarange, 1)
If InStr(1, datarange(y, 1), datarange(x, 1)) <> 0 Then
For z = LBound(datarange, 2) To UBound(datarange, 2)
Call swap(datarange(y, z), datarange(x, z))
Next z
y = UBound(datarange, 1)
x = x - 1
End If
Next y
Next x
'Set the Equation
Equation = datarange(1, 1)
'Replace the variables in the equation with values
For x = 2 To UBound(datarange, 1)
Equation = Replace$(Equation, datarange(x, 1), datarange(x, 2))
Next x
'rest of function here
End Function
Public Sub swap(A As Variant, B As Variant)
Dim Temp As Variant
Temp = A
A = B
B = Temp
End Sub
I sorted by checking to see if text would substitute into other text in the list. Byron Wall made a good point that I could have sorted based on text length. Since I had completed this before I saw the suggestion it did not get implemented though I think it may have been a simpler approach.
Let me start by first thanking everyone for the help/intention to help. This community is phenomenal. Second: I'm pretty new at this- before this week I'd learned basic in highschool a decade ago but no other programming experience outside of theory.
Without further ado, here's my issue:
Working on code to find unique variables (I know there's a lot of opensource stuff out there, need to customize this though). When I go to populate the array with the very first string I run into an 'out of range' error at array(1), which I had explicity set (1 TO UB), with UB being the upper bound. I've also double checked the value of UB with msgbox and it's at 15 with my dummy data, so that shouldn't be an issue. I've set the values in the array to empty (have also done so with 0, to no avail).
The error occurs at "ResultArray(1) = CurrentArray(1)"
I'm at a loss; any assistance would be much appreciated.
Option Explicit
Sub unque_values()
'''''''''Variable declaration
'
' CurrentArray() is the array taken from the worksheet
' Comp is the method of comparing inputs (either case sensitive or case insensitive)
' resultarray() is the array that unique values are placed
' UB is the upper bound of Result Array
' resultindex is the variable that keeps track of which cells are unique and which are not
' n is a helped variable that assists with resizing the array
Dim currentarray() As Variant
Dim comp As VbCompareMethod
Dim resultarray() As Variant
Dim UB As Long
Dim resultindex As Long
Dim n As Long
Dim v As Variant
Dim inresults As Boolean
Dim m As Long
' set variables to default values
Let comp = vbTextCompare
Let n = 0
' count the number of cells included in currentarray and populate with values
Let n = ActiveWorkbook.Worksheets("Data").Range("A:A").Count
Let UB = ActiveWorkbook.Worksheets("Data").Range("A" & n).End(xlUp).Row
' dimension arrays
ReDim resultarray(1 To UB)
ReDim currentarray(1 To UB)
' don't forget to change to named ranges
Let currentarray() = Range("f2", "f" & UB)
' populate resultarray with empty values
For n = LBound(resultarray) To UBound(resultarray)
resultarray(n) = Empty
Next n
MsgBox (n)
'check for invalid values in array
For Each v In currentarray
If IsNull(n) = True Then
resultarray = CVErr(xlErrNull)
Exit Sub
End If
Next v
' assumes the first value is unique
resultindex = 1
'''''''''''''''''''''''''''''''''''''''''error is this line''''''''''''''
resultarray(1) = currentarray(1)
' Search for duplicates by cycling through loops
' n = index of value being checked
' m = index of value being checked against
For n = 2 To UB
Let inresults = False
For m = 1 To n
If StrComp(CStr(resultarray(m)), CStr(currentarray(n)), comp) = 0 Then
inresults = True
Exit For
End If
Next m
If inresults = False Then
resultindex = resultindex + 1
resultarray(resultindex) = currentarray(n)
End If
Next n
ReDim Preserve resultarray(1 To resultindex)
End Sub
You've assigned to currentArray a range array. These are always two-dimensional arrays.
You should be able to resolve it with:
resultarray(1) = currentarray(1, 1)
You would need to modify a few more lines in your code to refer to both dimensions of the array.
Alternatively, with the least manipulation to your existing code, transpose the array which turns it to a one-dimensional array. This should require no other changes to your code.
Let currentArray() = Application.Transpose(Range("f2", "f" & UB))
Try with ActiveWorkbook.Worksheets("Data").UsedRange.Columns(1).cells.Count
I'm trying to store some reference data in a string array and then use that later on to compare with another string array. However, the code is not working since I'm getting a "subscript out of range" error (see code comment below).
Sub StoreBaseReferences()
Dim cell As Range
Dim val As Variant
Dim stringValues() As String
Dim i, rowCounter, columnCounter As Integer
rowCounter = 0
columnCounter = 0
For i = 2 To Sheets("sheet").UsedRange.rows.Count
For Each cell In Range(Cells(i, 2), Cells(i, 4))
stringValues(rowCounter, columnCounter) = cell.Value 'this is throwing the subscript ouf of range error
columnCounter = columnCounter + 1
Next cell
rowCounter = rowCounter + 1
columnCounter = 0
Next i
MsgBox (stringValues(0, 0))
End Sub
What is missing here?
Arrays in VBA need to be dimensioned with the number of elements that are expected to be used. You've defined the dimension, but not specified how many elements will be added to it. Try adding the following line just before the For loop:
ReDim stringValues(Sheets("sheet").UsedRange.Rows.Count, 3)
you are declaring a 1d array Dim stringValues() As String
but trying to use it as a 2d array stringValues(rowCounter, columnCounter)
Also, you are not declaring the size of the array and you are trying to use it. In VBA you have to make sure you tell the size of the array at the declaration time.
To delcare the count of elements that the array is capable of storing
Dim stringArray(0 to 10) or Dim stringArray(10)
and when iterating the counter starts at 0.
Using ReDim stringValues() allows you to resize the bounds at a later stage.
The topic is too broad to go over in one answer so check out the links to learn out how to dimension your array
VBA arrays
Array in Excel VBA
I would like to know what I'm doing wrong...
I have a word document open (in word 2010) with three tables in it. I wanted to test basic table extraction in VBA and followed the instructions http://msdn.microsoft.com/en-us/library/office/aa537149(v=office.11).aspx.
Sub ExtractTableData()
Dim doc As Word.Document
Dim tbl As Word.Table
Dim rng As Word.Range
Dim sData As String
Dim aData1() As String
Dim aData2() As String
Dim aDataAll() As String
Dim nrRecs As Long
Dim nrFields As Long
Dim lRecs As Long
Dim lFields As Long
Set doc = ActiveDocument
Set tbl = doc.Tables(1)
Set rng = tbl.ConvertToText(Separator:=vbTab, _
NestedTables:=False)
' Pick up the delimited text into and put it into a string variable.
sData = rng.Text
' Restore the original table.
doc.Undo
' Strip off last paragraph mark.
sData = Mid(sData, 1, Len(sData) - 1)
' Break up each table row into an array element.
aData1() = Split(sData, vbCr)
nrRecs = UBound(aData1())
' The messagebox below is for debugging purposes and tells you
' how many rows are in the table. It is commented out but can
' be used simply by uncommenting it.
'MsgBox "The table contained " & nrRecs + 1 & " rows"
'Process each row to break down the field information
'into another array.
For lRecs = LBound(aData1()) To nrRecs
aData2() = Split(aData1(lRecs), vbTab)
' We need to do this only once!
If lRecs = LBound(aData1()) Then
nrFields = UBound(aData2())
ReDim Preserve aDataAll(nrRecs, nrFields)
End If
' Now bring the row and field information together
' in a single, two-dimensional array.
For lFields = LBound(aData2()) To nrFields
aDataAll(lRecs, lFields) = aData2(j)
Next
Next
End Sub
I'm getting an error at this line: ReDim Preserve aDataAll(nrRecs, nrFields), which is due to "nrFields" being set to a negative value (-1)...
No idea how the upper bound of the array is a negative value... Any help on this would be much appreciated.
I figured it out - I was trying to extract a nested table. I had to cycle through all sub-tables and extract individually. Also, I had to search for and remove ^p before extraction to retain table structure.
After I had figured it out, I noticed that the MS code sample had an error: aData2(j) should actually be aData2(lFields).
Hope this helps some other newbie!
If UBound is -1 and LBound = 0, the array is empty. You can generate an empty array as follows:
Dim EmptyArray() As String
Dim s As String
EmptyArray = Split("")
Debug.Print (UBound(EmptyArray)) ' displays -1
Debug.Print (LBound(EmptyArray)) ' displays 0
In your case I suspect you need to skip the processing if the array is empty:
aData1 = Split(...)
If (UBound(aData1) < LBound(aData1) Then
' UBound is -1 and LBound is 0, array is empty, nothing to do
Else
' Array is non-empty, do your stuff
End If
Although quite bizarre, it is possible for VARIANT SAFEARRAY to have negative lower and upper bound values for any of the dimensions. The array extent is LBound(,dimension) to UBound(,dimension).
What must be true is UBound >= LBound.
To get the array size, use UBound - LBound + 1.
It used to be convention to set the lower bound using an Option Base statement at the top of VBA code although, of course, that didn't affect arrays being returned by 3rd party libraries. Most folk used to use 1 as the lower bound.
I need a help/guidance on Covariance calculation. I've written the below Procedure to calculate the covariance for 10 years of stock data. The problem is I am getting an error stating subscript out of range. The way I am calling the function is
CalcCovarAll firstColPick:=17, SecColPick:=17, ColPrint:=42
'firstColPick is the address of the first column pick
'secColPick is the address of the second column pick
'colPrint is to print the output onto particular column of the cell.
Any quick help would be very helpful. I think Ive not implemented the function correctly
Sub CalcCovarAll(ByVal firstColPick As Integer, ByVal SecColPick As Integer, ByVal ColPrint As Integer)
Dim secondPick As Range
Dim secondValue As Variant
Dim firstPick As Range
Dim firstValue As Variant
Dim wksSheet As Worksheet
Dim rowPrint As Range
Dim cvaluePrint As Variant
Dim Row As Integer
Dim col As Integer
'setting up the active worksheet
Set wksSheet = Workbooks("VaR_cw2 (2).xlsm").Worksheets("Sheet1")
'setting up the pickup of first column
Set firstPick = Range(Cells(4, firstColPick), Cells(2873 + 1, firstColPick))
firstValue = firstPick.Value
'setting up pickup of second column
Set secondPick = Range(Cells(4, SecColPick), Cells(2873 + 1, SecColPick))
secondValue = secondPick.Value
'setting up column printing
Set rowPrint = Range(Cells(5, ColPrint), Cells(2873 + 1, ColPrint))
cvaluePrint = rowPrint.Value
For Row = LBound(secondValue) To UBound(secondValue) - 1
cvaluePrint(Row + 1, 1) = Application.Covar(firstValue, secondValue)
Next Row
rowPrint = cvaluePrint
End Sub
If you are getting error on below line then make sure the file name is correct and the file exists on your hard drive and is open.
Set wksSheet = Workbooks("VaR_cw2 (2).xlsm").Worksheets("Sheet1")
use Option Base 1 on top of code and change the below lines
For Row = LBound(secondValue) To UBound(secondValue)
cvaluePrint(Row + 1, 1) = Application.Covar(firstValue, secondValue)
Next Row
Also make sure your input variables are greater than 0.
Henceforth kindly specify the line number as well when you post any questions for any errors. Screenshot if possible. It will help your query to resolve faster.
rowPrint starts at line 5, while secondPick starts a line 4.
That means cvaluePrint contains on item less than secondValue.
cvaluePrint (1 to 2870) (5 to 2874 - all arrays in VBA starts at 1, not at 5)
secondValue (1 to 2871) (4 to 2874 - all arrays in VBA starts at 1, not at 4)
When you do the Row loop, it goes from 1 to 2870But when you type cvaluePrint(Row + 1, 1), you are calling from 2 to 2871.
That last Row is out of range.
Use cvaluePrint(Row, 1)
Change
cvaluePrint(Row + 1, 1) = Application.Covar(firstValue, secondValue)
To
cvaluePrint(Row, 1) = Application.Covar(firstValue, secondValue)
Since UBound(cvaluePrint) = 2870, so when Row = 2870, Row + 1 exceeds the upper bound for the variant cvaluePrint in the very last iteration of the for loop.