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.
Related
I am trying to use two VLookUps in a row in my macro. The macro counts the IDs in column A and C, searches for the ID description in another table (same sheet and ranges from column F to M -> F = IDs, H = ID description) and continues this search until the count is reached and inserts them in column B and D.
Unfortunately, I get a
run time error 1004
when using the second VLookUp. First one works fine and it's exactly the same as in the first one I am just referring to different cells.
Picture reference of what I am trying to achieve:
Does anyone know what causes this problem?
Dim i As Integer
Dim shA As Worksheet
Set shA = Worksheets(Format(Date, "dd.mm.yyyy"))
With shA
For i = 4 To .Range("A4", .Range("A4").End(xlDown)).Rows.Count + 3
.Cells(i, 2) = .Application.WorksheetFunction.VLookup(.Cells(i, 1), .Range("F:M"), 3, False)
Next i
For i = 4 To .Range("C4", .Range("C4").End(xlDown)).Rows.Count + 3
.Cells(i, 4) = .Application.WorksheetFunction.VLookup(.Cells(i, 3), .Range("F:M"), 3, False)
Next i
End With
Try to replace Integer with Long and try again.
In VBA Integer is
from -2^15 to 2^15-1 or
from -32768 to 32767
Thus, if you use it in Excel and it refers numbers which are outside this range, you get an error. In general, you have some other errors as well. Try this and make sure that you have the correct ActiveSheet selected (I have done it for easy, you may change it later):
Public Sub TestMe()
Dim i As Long
Dim shA As Worksheet
Set shA = ActiveSheet
With shA
For i = 4 To .Range("A4", .Range("A4").End(xlDown)).Rows.Count + 3
.Cells(i, 2) = Application.VLookup(.Cells(i, 1), .Range("F:M"), 3, False)
Next i
For i = 4 To .Range("C4", .Range("C4").End(xlDown)).Rows.Count + 3
.Cells(i, 4) = Application.VLookup(.Cells(i, 3), .Range("F:M"), 3, False)
Next i
End With
End Sub
Thus, in general:
Do not use On Error Resume Next, because it is a bit tough.
When you use With Worksheets("someName"), then make sure that every time you put a dot ., the child is a real child of the with-Parent. In your case .Application is not a child of Worksheets()
Do not use Integer, but Long
I was trying to take some values from an excel sheet, to then process them, and I decided to use a Dynamic array, because I thought that it would be easier.
Dim Dias() As Variant
Dim Horas() As Variant
Dim Temp() As Variant
Dim Hum() As Variant
Sheets("Tfinal").Activate
Dias = Range("A2:A1745")
Horas = Range("B2:B1745")
Temp = Range("J2:J1745")
Sheets("Hfinal").Activate
Hum = Range("D2:D1745")
Dim TempNTemp() As Double
Dim NTemp() As Double
Dim NDias() As Variant
Dim NHoras() As Variant
Dim TempNHum() As Variant
Dim NHum() As Variant
Until here everything's fine, but the next line throws subscript out of range error. I'm really confused.
H = Horas(0)
Getting values from a range of cells always results in a 2-D array with a 1-based index. If you use a number of cells in a single column you still get a 1 to x, 1 to 1 array; if you use a number of cells in a single row you will get a 1 to 1, 1 to x array.
Your arrays are LBound/UBound/Ranked as follows:
Dias = Range("A2:A1745") 1 to 1744, 1 to 1
Horas = Range("B2:B1745") 1 to 1744, 1 to 1
Temp = Range("J2:J1745") 1 to 1744, 1 to 1
Hum = Range("D2:D1745") 1 to 1744, 1 to 1
So to access the first element of the first rank Horas array use one of the following:
Horas(1, 1)
Horas(LBound(Horas, 1), 1)
Truth be told, the default for the second rank is 1 so it is unnecessary. These will work just as well.
Horas(1)
Horas(LBound(Horas))
However, using that shorthand can cause confusion if you had more than a single second rank.
Horus = Range("A1:G1")
'first element
Horas(1, 1)
Horas(1, LBound(Horas, 2))
'second element
Horas(1, 2)
Setting a Watch on the array var will show you the dimensions as well as the contents.
I also use the following code within the procedure to visually see the array's dimensions in the Immediate window.
debug.print lbound(Horus, 1) & ":" & ubound(Horus, 1)
debug.print lbound(Horus, 2) & ":" & ubound(Horus, 2)
'results for Horus
1:1744
1:1
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.
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.
I am pulling out values from a variable number of sheets within excel (fifth to third from last), each of which contains a variable number of "entries". E.G. "Entry 1" has values I want in columns F and H. "Entry 2" has values I want in columns K and M, etc. (These are also referred to as "quotes" in the comments for the code).
I'm using a For loop within a For loop to accomplish this. The issue I'm having is that each recursion of the "parent" for loop is over-writing the entries created in the previous recursion. My code illustrates:
Sub ListSheets()
' Creating an integer that specifies the size of the arrays of column entries
' and thus the maximum number of quotes.
Dim array_size As Integer
'Defining Arrays that will be used to select quantities of different quotes
'(e.g. Class)
'Region, Date and Price all have the same column entries, meaning only one array is
'required.
Dim Class_Cols_Array() As Integer
Dim RDP_Cols_Array() As Integer
'Resizing these arrays. This resize sets the maximum number of quotes per sheet to
'1000.
array_size = 1000
ReDim Class_Cols_Array(1 To array_size, 1 To 1)
ReDim RDP_Cols_Array(1 To array_size, 1 To 1)
'Setting the first entries as the corresponding column indexes of H and F
'respectively.
Class_Cols_Array(1, 1) = 8
RDP_Cols_Array(1, 1) = 6
' Filling both arrays with column indexes of quotes. In both cases the row number is
'the same for each quote and thus
' does not need to be specified for each entry.
For intLoop = 2 To 1000
Class_Cols_Array(intLoop, 1) = Class_Cols_Array(intLoop - 1, 1) + 5
RDP_Cols_Array(intLoop, 1) = RDP_Cols_Array(intLoop - 1, 1) + 5
Next
'Defining an array which will contain the number of entries/quotes (as defined by
' the user) for each sheet/manufacturer.
Dim Num_of_Entries() As Integer
' Resizing this array to match the number of manufacturers (sheets therein) within
'the workbook.
ReDim Num_of_Entries(1 To Worksheets.Count - 6, 1 To 1)
'Defining arrays that will contain will be populated with quote quantities (e.g.
'Class), pulled from cells.
Dim Class_Array() As String
Dim Region_Array() As String
Dim Date_Array() As String
Dim Price_Array() As String
Dim Manufacturer_Array() As String
'Here number of entries for each manufacturer (sheet) are pulled out, with this
'value being entered into the appropriate cell(B5)
'by the user.
Dim i As Integer
For i = 5 To Worksheets.Count - 2
j = i - 4
Num_of_Entries(j, 1) = ThisWorkbook.Worksheets(i).Cells(5, 2)
Next
'Creating an integer that is the total number of entries (that for all sheets
'combined).
Dim total_entries As Integer
total_entries = WorksheetFunction.Sum(Num_of_Entries)
'Setting the size of each quantity-containing array to match the total number of
'entries.
ReDim Class_Array(1 To total_entries, 1 To 1)
ReDim Region_Array(1 To total_entries, 1 To 1)
ReDim Date_Array(1 To total_entries, 1 To 1)
ReDim Price_Array(1 To total_entries, 1 To 1)
ReDim Manufacturer_Array(1 To total_entries, 1 To 1)
'Creating a variable for the numbers of entries for a specific sheet.
Dim entries_for_sheet As Integer
'Creating a variable for the sheet number for a specific sheet (e.g. "Acciona_Fake
'is the 5th sheet).
Dim sheet_number As Integer
'Looping over the sheets (only fifth to third from last sheets are of interest).
For sheet_number = 5 To Worksheets.Count - 2
'Creating an iterating value that starts at 1 in order to match sheets to their
'number of entries.
j = sheet_number - 4
entries_for_sheet = Num_of_Entries(j, 1)
'Looping over the entries for each sheet, extracting quote quantities and adding
'to their respective arrays.
For i = 1 To entries_for_sheet
Class_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6,
Class_Cols_Array(i, 1))
Region_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6,
RDP_Cols_Array(i, 1))
Date_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(8,
RDP_Cols_Array(i, 1))
Price_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(41,
RDP_Cols_Array(i, 1))
Manufacturer_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Name
Next
Next
'Exporting all arrays.
Sheets("vba_deposit").Range("A1").Resize(UBound(Class_Array)).Value = Class_Array
Sheets("vba_deposit").Range("B1").Resize(UBound(Region_Array)).Value = Region_Array
Sheets("vba_deposit").Range("C1").Resize(UBound(Date_Array)).Value = Date_Array
Sheets("vba_deposit").Range("D1").Resize(UBound(Price_Array)).Value = Price_Array
Sheets("vba_deposit").Range("D1").Resize(UBound(Manufacturer_Array)).Value =
Manufacturer_Array
End Sub
Looking at the for loop within a for loop at the bottom, I need to find a way to keep the iteration of the RHS of the equation(s). E.G. I need the i value to be the same for,
ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1))
whereas I need the i on the LHS of the equation to also increase with each run of the "parent" for loop. I.E. I need the i to be the "number of entries thus far" + i for
ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1))
I can't figure out a way to do this. Is there perhaps a way to append an array rather than assigning values to individual elements? (This sounds really simple but I've searched and not been able to find a genuine append method, only loops of assigning to elements).
Many thanks in advance.
Compiled but not tested:
Sub ListSheets()
Dim intLoop As Long, i As Long, total_entries As Long
Dim sht As Worksheet, sheet_number As Long
Dim entries_for_sheet As Long
Dim classCol As Long, RDPCol As Long
Dim entry_num As Long
Dim Data_Array() As String
total_entries = 0
entry_num = 0
For sheet_number = 5 To Worksheets.Count - 2
Set sht = ThisWorkbook.Worksheets(sheet_number)
entries_for_sheet = sht.Cells(5, 2).Value
total_entries = total_entries + entries_for_sheet
'can only use redim Preserve on the last dimension...
ReDim Preserve Data_Array(1 To 5, 1 To total_entries)
classCol = 8
RDPCol = 6
For i = 1 To entries_for_sheet
entry_num = entry_num + 1
Data_Array(1, entry_num) = sht.Cells(6, classCol)
Data_Array(2, entry_num) = sht.Cells(6, RDPCol) ' 6?
Data_Array(3, entry_num) = sht.Cells(8, RDPCol)
Data_Array(4, entry_num) = sht.Cells(41, RDPCol)
Data_Array(5, entry_num) = sht.Name
classCol = classCol + 5
RDPCol = RDPCol + 5
Next
Next
Sheets("vba_deposit").Range("A1").Resize(UBound(Data_Array, 2), _
UBound(Data_Array, 1)).Value = Application.Transpose(Data_Array)
End Sub