Storing and pasting an entire range - vba

All, I'm trying to do a quasi-montecarlo analysis, and have had success storing values from single cells into an array during every draw, and then pasting later. When I'm trying to store an entire row into an array, though, the script doesn't seem to work. Hoping someone can shed some insight, thank you for your help! This issue is somewhere in the curvearray, which is copying 10 cells in the same row on each draw.
Dim randa As Double
Dim stdeva As Double
Dim looprun As Double
Dim arrayone() As Variant
Dim arraytwo() As Variant
Dim curvearray() As Variant
ReDim arrayone(1 To 1)
ReDim arraytwo(1 To 1)
ReDim curvarray(1 To 10)
stdeva = 1
a = Range("baseline").Value
For looprun = 1 To 100
randa = Rnd
Range("baseline").Value = WorksheetFunction.NormInv(randa, a, stdeva)
Application.Calculate
arrayone(UBound(arrayone)) = Range("net").Value
ReDim Preserve arrayone(1 To UBound(arrayone) + 1)
arraytwo(UBound(arraytwo)) = Range("multi").Value
ReDim Preserve arraytwo(1 To UBound(arraytwo) + 1)
curvearray(UBound(curvearray)) = Range("curve").Value
ReDim Preserve curvearray(1 To UBound(curvearray) + 1)
Next looprun
Range("onepaste").Resize(UBound(arrayone)) = Application.Transpose(arrayone)
Range("twopaste").Resize(UBound(arraytwo)) = Application.Transpose(arraytwo)
Range("curvepast").Resize(UBound(curvearray)) = Application.Transpose(curvearray)
End Sub

Related

Type mimsatch when assigning result of MMult to an array variable

Apologies for the newbie question, but I couldn't find an answer when searching.
I'm fairly new to matrix manipulation in VBA. I keep on getting a type mismatch with the following code.
Sub matrixtest()
Dim matrix1() As Integer
Dim matrix2() As Integer
Dim matrix3() As Integer
Dim i, j, k As Integer
'populate matrix1
ReDim matrix1(3, 3)
For j = 1 To 3
For i = 1 To 3
matrix1(i, j) = Range("C5").Offset(i - 1, j - 1)
Next i
Next j
'populate matrix2
ReDim matrix2(3, 3)
For j = 1 To 3
For i = 1 To 3
matrix2(i, j) = Range("G5").Offset(i - 1, j - 1)
Next i
Next j
ReDim matrix3(3, 3)
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
End Sub
If you replace the line
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
By
Debug.Print TypeName(matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2))
The output is:
Variant()
Which can't be assigned to an Integer().
I would recommend replacing
Dim matrix1() As Integer
Dim matrix2() As Integer
Dim matrix3() As Integer
Dim i, j, k As Integer
by
Dim matrix1, matrix2, matrix3 As Variant 'note lack of ()
Dim i, j, k As Long 'Integer is borderline obsolete in VBA
Variants do a nice job of holding and passing arrays and tend to handle any needed type conversions automatically. When dealing with arrays in VBA, I tend to use them almost exclusively. For one thing, it makes it easy to load arrays from ranges.
Just use ReDim to make the variants hold arrays:
ReDim matrix1(1 to 3, 1 to 3) 'doesn't hurt to be explicit about lower bounds
ReDim matrix2(1 to 3, 1 to 3)
'load arrays...
'no need to redim matrix3, just:
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
There is an even shorter way of doing what you are trying to do:
matrix1 = Range("C5:E7").Value
matrix2 = Range("G5:I7").Value
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
In the above code you don't need to use any preliminary ReDim. When you want to load the values of a rectangular range into a variant in VBA, you don't need to loop, which is needlessly slow. Just assign the values in one fell swoop.

VBA Excel: Paste large array to range

I'm working in VBA for excel. I have an array called "aKey" (1 by 137,000 strings but exact size is subject to change so making code generic is a neccesity). I need to paste aKey to the first column of a a worksheet. So far i have tried
Range(.Offset(1,0),.Offset(UBound(aKey)+1,0)).Value = aKey
but this seems to only paste 137,000 versions of the first entry of the array.
I have also tried
Range(.Offset(1,0),.Offset(UBound(aKey)+1,0)).Value = WorksheetFunction.Transpose(aKey)
which also didn't work. Through a google search I did find that the Transpose function has a limited pasting size which may very well be the problem there. Does anybody know of a method to avhieve my goal? Thanks
Sub Tester()
Dim a1(), a2(), i As Long, ub As Long
ReDim a1(1 To 1, 1 To 137000)
'load source array ("wrong" shape)
For i = 1 To 137000
a1(1, i) = i
Next i
ub = UBound(a1, 2)
ReDim a2(1 To ub, 1 To 1) 'resize a2 ("right" shape) to match a1
' "flip" the a1 array into a2
For i = 1 To ub
a2(i, 1) = a1(1, i)
Next i
'drop a2 to worksheet
ActiveSheet.Range("a1").Resize(ub, 1).Value = a2
End Sub
Here is an example of creating an array for a single column and placing it in a column:
Sub qwerty()
Dim aKey(1 To 137000, 1 To 1) As Variant
For i = 1 To 137000
aKey(i, 1) = Rnd
Next i
Range("A1:A137000") = aKey
End Sub

Debugging VBA code - appending values to array

I am trying to use code of the following form to populate an array of x rows:
Dim myarray() As Variant
Dim string1 As String
Dim myarray_ubound As Integer
myarray_ubound = 0
For i = 1 to x
myarray_ubound = myarray_ubound + 1
ReDim Preserve myarray(1 To myarray_ubound, 1 To 2)
myarray(myarray_ubound,1) = i
myarray(myarray_ubound,2) = string1
Next i
However, when I run it it gets stuck after the first loop, telling me that a subscript is out of range. Debugging takes me to the ReDim command.
I used myarray_ubound as an alternative to calling the UBound function many times, but I have tried using this as well and I get the same error.
Can anyone spot what's gone wrong?
See: http://msdn.microsoft.com/en-us/library/aa266231.aspx
"If you use the Preserve keyword, you can resize only the last array dimension and you can't change the number of dimensions at all."
Try
ReDim Preserve myarray(1 To 2, 1 To myarray_ubound)
instead.
you can only redim the last element of the array (not the first), see below. As you know x I would suggest to redim your array with this value from the beginning.
Dim myarray() As Variant
Dim string1 As String
Dim myarray_ubound As Integer
myarray_ubound = 0
For i = 1 To 10
myarray_ubound = myarray_ubound + 1
ReDim Preserve myarray(1 To 2, 1 To myarray_ubound)
myarray(1, myarray_ubound) = i
myarray(2, myarray_ubound) = string1
Next i
Since you are declaring the variable as a Variant i don't see why you need to re-dim. (maybe related to memory issues, feel free to fill in).
I would suggest:
For i = 1 to 10
myArray(1, i-1) = i
myArray(2, i-1) = string1
next i

Avoiding Overwriting for loop within a for loop vba

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

automating a mundane task

I have a simple task that i need to automate.
I get a email in a very specific format from another application based on a trigger.
What i want is that out look "reads" the data in that email and compare two cells. if one cell is greater than the other, then i want the email forwarded to a specified address otherwise delete the email.
the folowing vba code was attempted, but gives a run time error. please guide
Sub GetLines()
Dim msg As Outlook.mailItem
Dim rows As Variant
Dim numberofColumns As Long
Dim numberofRows As Long
Dim headerValues As Variant
Dim headerRow() As String
Dim data() As String
Dim i As Long, j As Long
' get currently selected email
Set msg = ActiveExplorer.Selection.item(1)
' tokenize each line of the email
rows = Split(msg.Body, vbCrLf)
' calculate array size
numberofColumns = Len(rows(0)) - Len(Replace(rows(0), Chr(9), ""))
numberofRows = UBound(rows) + 1
' put header row into array
ReDim headerRow(1 To numberofColumns)
headerValues = Split(rows(0), Chr(9))
For i = 1 To numberofColumns
headerRow(i) = Trim$(headerValues(i - 1))
Next i
' calculate data array size
numberofRows = numberofRows - 1
' put data into array
ReDim data(1 To numberofRows, 1 To numberofColumns)
For i = 1 To numberofRows
For j = 1 To numberofColumns
data(i, j) = Trim$(Split(rows(i), Chr(9))(j - 1))
Next j
Next i
End Sub
Your code makes too many unnecessary assumptions about the data and will give errors most of the time. Firstly you need to use F8 to step through the code to isolate the error in a particular line.
I suggest you change
Dim data() As String
to
Dim data As Variant
data = Array()
I'm not an expert in how VBA manages memory but I know that I get a lot less grief when I make things variants.
You are most likely to have a problem here:
For i = 1 To numberofRows
For j = 1 To numberofColumns
data(i, j) = Trim$(Split(rows(i), Chr(9))(j - 1))
Next j
Next i
What if not every row is perfectly formed?
Instead, try this:
For i = 1 To numberofRows
For j = 1 To Ubound(Split(rows(i), Chr(9))) + 1
data(i, j) = Trim$(Split(rows(i), Chr(9))(j - 1))
Next j
Next i
This allows your code to "survive" a blank line or some other error in the data.