Print Dynamic Error Array to Sheet - arrays

I'm having troubles getting my Error array to print to a range. I'm fairly sure I'm resizing it incorrectly, but I'm not sure how to fix it. I created a test add which just added garbage data from columns A and B, but normally AddPartError would be call from within various Subs/Functions, and then at the end of the main script process the array should be dumped onto a sheet. Here are the relevant functions:
Sub testadd()
For Each i In ActiveSheet.Range("A1:A10")
Call AddPartError(i.value, i.Offset(0, 1))
Next i
tmp = PartErrors
PrintArray PartErrors, ActiveWorkbook.Worksheets("Sheet1").[D1]
Erase PartErrors
tmp1 = PartErrors
PartErrorsDefined = 0
End Sub
Sub PrintArray(Data As Variant, Cl As Range)
Cl.Resize(UBound(Data, 1), 2) = Data
End Sub
Private Sub AddPartError(part As String, errType As String)
If Not PartErrorsDefined = 1 Then
ReDim PartErrors(1 To 1) As Variant
PartErrorsDefined = 1
End If
PartErrors(UBound(PartErrors)) = Array(part, errType)
ReDim Preserve PartErrors(1 To UBound(PartErrors) + 1) As Variant
End Sub

Ok. I did a bit of checking and the reason this doesn't work is because of your array structure of PartErrors
PartErrors is a 1 dimensional array and you are adding arrays to it, so instead of multi dimentional array you end up with a jagged array, (or array of arrays) when you actually want a 2d array
So to fix this, I think you need to look at changing your array to 2d. Something like the below
Private Sub AddPartError(part As String, errType As String)
If Not PartErrorsDefined = 1 Then
ReDim PartErrors(1 To 2, 1 To 1) As Variant
PartErrorsDefined = 1
End If
PartErrors(1, UBound(PartErrors, 2)) = part 'Array(part, errType)
PartErrors(2, UBound(PartErrors, 2)) = errType
ReDim Preserve PartErrors(1 To 2, 1 To UBound(PartErrors, 2) + 1) As Variant
End Sub
and
Sub PrintArray(Data As Variant, Cl As Range)
Cl.Resize(UBound(Data, 2), 2) = Application.Transpose(Data)
End Sub
NB. You also need to Transpose your array to fit in the range you specified.

You code is a little hard to follow, but redim clears the data that is in the array, so I think you need to use the "Preserve" keyword.
Below is some example code you can work through to give you the idea of how it works, but you will need to spend some time working out how to fit this into your code.
Good luck!
Sub asda()
'declare an array
Dim MyArray() As String
'First time we size the array I do not need the "Preserve keyword
'there is not data in the array to start with!!!
'Here we size it too 2 by 5
ReDim MyArray(1, 4)
'Fill Array with Stuff
For i = 0 To 4
MyArray(0, i) = "Item at 0," & i
MyArray(1, i) = "Item at 1," & i
Next
' "Print" data to worksheet
Dim Destination1 As Range
Set Destination1 = Range("a1")
Destination1.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).Value = MyArray
'Now lets resize that arrray
'YOU CAN ONLY RESIZE THE LAST SIZE OF THE ARRAY - in this case 4 to 6...
ReDim Preserve MyArray(1, 6)
For i = 5 To 6
MyArray(0, i) = "New Item at 0," & i
MyArray(1, i) = "New Item at 1," & i
Next
'and let put that next to our first list
' "Print" data to worksheet
Dim Destination2 As Range
Set Destination2 = Range("A4")
Destination2.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).Value = MyArray
End Sub

Related

Function gives Value error when returning array of arrays

I am trying to create a TextSplit function in Excel that can accept either a single reference or a range.
If it is a single string it returns an array of sub strings.
If it is a range it should return an array of sub string arrays.
A single string works but when I pass it a single column range it give me a #VALUE! error.
The commented lines work.
If I store the result of Array to arr Excel displays a grid of "test" strings.
If instead I set TextSplit to just arr(1) I get a single array of substrings similar to the single string version.
Function TextSplit(text, delimiter)
If IsArray(text) Then
Dim arr() As Variant: ReDim arr(0 To text.Count - 1)
For i = 1 To text.Count
arr(i-1) = Split(text(i), delimiter)
'arr(i-1) = Array("test", "test")
Next
TextSplit = arr
'TextSplit = arr(1)
Else
TextSplit = Split(text, delimiter)
End If
With the help of a different question Array and Split commands to create a 2 dimensional array
I was able to work your question out a bit, however I'm still unable to fill out the array from the cell where you'd call the function like with your single string which fills out in the columns next to it.
If it's for a column, you could just autofill text.split(cell,delimiter) if you're working from Excel.
If you're working from out vba and want to return the split array (2D like #Tim said) back to a sub:
Sub testingTextSplitter()
Dim arr As Variant, tArr As Variant
Dim testStr As String
testStr = Range("A1").Value 'Testing single cell
Range("G2").Value = TextSplit(testStr, "-")
arr = Range("A1:A8").Value
tArr = TextSplit(arr, "-")
For i = 0 To UBound(tArr, 1)
For j = 0 To UBound(tArr, 2)
Cells(i + 3, j + 3).Value = "'" & tArr(i, j) 'fills out from Range("C3"), adjust as needed
' This writing out is basically the same as fillingdown the formule of text.split() btw
Next j
Next i
End Sub
With the Function
Function TextSplit(tArray As Variant, delimiter As String) As String()
If IsArray(tArray) Then
Dim uBoundInput As Long, uBoundCells As Long 'I couldn't get your arr.Count to work on my end so gotta use the UBound
Dim arr() As String, testArr() As String
Dim i As Long, j As Long, maxColumns As Long
uBoundInput = UBound(tArray)
maxColumns = 0
For i = 0 To uBoundInput - 1
Debug.Print (tArray(i + 1, 1))
testArr = Split(tArray(i + 1, 1), "-")
uBoundCells = UBound(testArr)
If maxColumns < uBoundCells Then
maxColumns = uBoundCells
End If
Next i
ReDim arr(0 To uBoundInput - 1, 0 To maxColumns)
For i = 0 To uBoundInput - 1
testArr = Split(tArray(i + 1, 1), "-")
For j = 0 To UBound(testArr)
arr(i, j) = testArr(j)
Next j
Next i
TextSplit = arr()
Else
TextSplit = Split(tArray, delimiter)
End If
End Function
I'm quite new to VBA as well so apologies in advance for redundancies like not filling testArray when figuring out the maxColumns, I couldn't figure that one out. First time working with 2D arrays.
Other question that might help:
VBA UDF Return Array
(I tried using the array formulay with {} but got same Value error as before)
Hope this helps.
I don't know what happened, but the array branch of my code is now working. I have been messing with a few things, but I am not sure why it is working. The "As Variant()" declaration is new from the above code, but that may have been omitted before. (This code is on my work machine but I wrote the original post from my personal computer so I couldn't copy and paste. I am on my work computer now.)
The only other change that I made was to the index values of the arr array.
Thanks for your help, not sure what was wrong or how it got fixed though.
Function TextSplit(text, delimiter) As Variant()
If IsArray(text) Then
Dim arr() As Variant: ReDim arr(1 To text.Count)
For i = 1 To text.Count
arr(i) = Split(text(i), delimiter, -1, 1)
Next
TextSplit = arr
Else
TextSplit = Split(text, delimiter, -1, 1)
End If
End Function

sort two dim array which is declared as one dim array and inserted values as array()

I'm on dead end which I am no able to figure out even google up :(
Let's say I have this exemple (please do not comment that it might be better ways to create such an array, this is on purpose):
Dim someArray() As Variant: ReDim someArray(0 To 0)
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text1"), CLng(5), CDbl(100))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text2"), CLng(3), CDbl(101))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text4"), CLng(2), CDbl(102))
ReDim Preserve someArray(0 To UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text3"), CLng(1), CDbl(100))
and what I need is to fugure out the function to sort by two columns in the someArray() from (1 to UBound(someArray)) based on two colums I pass as arguments:
so eather first sort by second column (1) which is CStr, and if records are the same then sort by third column (2)
or which two columns I will set as arguments in the function to sort out
Unfortunately I am very lost here... only option which is realy terrible is to insert data into new sheet, let worksheet function to sort it accordingly, and reinsert into array, which is something i definitely do not wish to do :(
thank you for ideas...
I took your question as a challenge and found a way to pseudo sort the jagged array in the way you need. I mean, it will rearrange the jagged array arrays according to their second element, or according to the third one, if the second ones are in good order:
Sub SortArraysInJaggedArray()
Dim someArray() As Variant: ReDim someArray(0)
someArray(0) = Array(6, CStr("text1"), CLng(5), CDbl(100)) 'to load the first array element. Otherwise, it would be empty
ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text2"), CLng(3), CDbl(101))
ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text4"), CLng(2), CDbl(102))
ReDim Preserve someArray(UBound(someArray) + 1): someArray(UBound(someArray)) = Array(6, CStr("text3"), CLng(1), CDbl(100))
Dim arrS
arrS = sortJaggArr(someArray, 1)
'visually test the result:
Debug.Print someArray(2)(1), arrS(2)(1): Stop
Debug.Print someArray(3)(1), arrS(3)(1): Stop
End Sub
Function sortJaggArr(arrJ As Variant, sortCol As Long) As Variant
Dim i As Long, j As Long, arrInit, arrSort, arrComp, arrMtch
ReCheck:
ReDim arrInit(UBound(arrJ))
For i = 0 To UBound(arrJ)
arrInit(i) = arrJ(i)(sortCol)
Next
arrSort = arrInit: BubbleSort arrSort
'Debug.Print Join(arrInit, "|"): Debug.Print Join(arrSort, "|")
'build a comparison array a continuous range of numbers:
arrComp = Evaluate("TRANSPOSE(ROW(1:" & UBound(arrInit) + 1 & "))")
'obtain an array of each element matching:
arrMtch = Application.match(arrInit, arrSort, 0) 'returns an array of matches
'Debug.Print Join(arrMtch, "|"): Stop
'check if arrSort is different than arrInit:
If Join(arrComp, "") = Join(arrMtch, "") Then 'if they match, try the next column
sortCol = sortCol + 1
If sortCol <= 2 Then GoTo ReCheck
End If
If sortCol = UBound(arrJ) Then
MsgBox "The array is already sorted..."
sortJaggArr = arrJ: Exit Function
End If
'Debug.Print Join(arrComp, "|"): Debug.Print Join(arrMtch, "|"): Stop
'make the sorting of arrays
Dim newArr: ReDim newArr(UBound(arrJ))
For i = 0 To UBound(arrJ)
If arrComp(i + 1) = arrMtch(i + 1) Then
newArr(i) = arrJ(i)
Else
newArr(i) = arrJ(arrMtch(i + 1) - 1)
End If
Next i
sortJaggArr = newArr
End Function
Private Sub BubbleSort(arr)
Dim i As Long, j As Long, temp
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(i): arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
End Sub
I let in the function (for instructional purpose) some commented lines, to offer the possibility to see what is the return of specific (joined) arrays...
Please, send some feedback after testing it.
If something not clear enough, please do not hesitate to ask for clarifications...

Adjust Values As They Are Being Stored In VBA Array

I am trying to write Column A to an array and while passing into the array or when writing the array to the sheet, I would like to multiple each value stored by a set number (specifically .01). I will be writing the array back over the same column it was set from.
Ex.
Sheet before macro:
Col A Col B Col C
Header Header Header
100
50
50
40
100
Sheet after macro:
Col A Col B Col C
Header Header Header
1
.5
.5
.4
1
So far I have been working off a basic array portion of code from a tutorial I saw online shown below:
Sub ArrayTest
Dim Arr() As Variant
Arr = Range("A1:A6")
Dim R As Long
Dim C As Long
For R = 1 To UBound(Arr, 1) ' First array dimension is rows.
For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
Debug.Print Arr(R, C)
Next C
Next R
'resize range array will be written to
Dim Destination As Range
Set Destination = Range("K1")
Destination.Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
'transpose / write array to range
Set Destination = Range("A1")
Destination.Resize(UBound(Arr, 2), UBound(Arr, 1)).Value = Application.Transpose(Arr)
End Sub
This code has no errors, but I'm unsure of where / how I can "manipulate" the values (either on the way into the array or on the way back to the sheet).
An array may not even be the best way to achieve this overall goal of overwriting a columns values with itself multiplied by a another number. I know I could write the column to a dummy sheet, do the calculation then move back over the original sheet and column, but I was trying to find something cleaner and potentially faster than that. This is also a simplified example, my actual data set is much larger and more variable, but for the ease of discussion I created this example.
Any advice is much appreciated!
Here's a "no loop" approach:
Sub Tester()
Dim arr, rngSrc As Range, sht As Worksheet
Set sht = ActiveSheet
Set rngSrc = sht.Range("A2:A6")
arr = rngSrc.Parent.Evaluate(rngSrc.Address() & " * 10") '<< returns an array
sht.Range("B2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub
For your specific case:
With Range("A2:A6")
.Value = .Parent.Evaluate(.Address & " * 0.01")
End With
You can do it like this, but easier to use pastespecial (multiply or divide).
Sub x()
Dim v As Variant, i As Long
v = Range("A2:A6").Value
For i = LBound(v) To UBound(v)
v(i, 1) = v(i, 1) * 0.01
Debug.Print v(i, 1)
Next i
Range("A2:A6").Value = v
End Sub
Was working on this as I saw Tim post... similar use of evaluate, but doesn't need an additional array or loop:
Dim rng As Range, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range(Cells(1, 1), Cells(lr, 1))
rng = Evaluate(rng.Address & "*0.01")
Perhaps you should collect the values first and process the adjustment(s) in memory.
dim i as long, arr as variant
with worksheets("sheet1")
arr = .range(.cells(2, "A"), .cells(.rows.count, "A").end(xlup)).value2
for i=lbound(arr, 1) to ubound(arr, 1)
arr(i, 1) = arr(i, 1)/100
next i
for i=lbound(arr, 1) to ubound(arr, 1)
debug.print arr(i, 1)
next i
.cells(1, "K").resize(ubound(arr, 1), ubound(arr, 2)) = arr
.cells(1, "L").resize(ubound(arr, 2), ubound(arr, 1)) = application.transpose(arr)
end with

Editing Array in VBA

I am trying to capture a table via an array, and iterate through the array multiple times, changing the data in two columns through each iteration. My current code (below) is set up to iterate through the array once, changing the data in two sections (, 5) and (, 6). Unfortunately, it displays an error reading
Run-time error '9': Subscript out of range
Sub arraytest()
Dim myArray As Variant
myArray = ActiveWorkbook.Worksheets("Semesters").ListObjects("tblSemester").DataBodyRange.Value
Dim i As Integer
Dim Roww As Integer
Roww = 1
While i < 10
For Each r In myArray
myArray(i, 5) = "18/19"
myArray(i, 6) = "Fall"
Roww = Roww + 1
i = 10
Next
Wend
Worksheets("Sheet1").Range("A2", "U2").Resize(UBound(myArray, 1)).Value = myArray
End Sub
How to I edit the code to successfully iterate through the array, changing the data on the specific columns?
I think you want this:
Sub arraytest()
Dim myArray As Variant
Dim i As Integer
myArray = ActiveWorkbook.Worksheets("Semesters").ListObjects("tblSemester").DataBodyRange.Value
For i = 1 To UBound(myArray, 1)
myArray(i, 5) = "18/19"
myArray(i, 6) = "Fall"
Next
Worksheets("Sheet1").Range("A2").Resize(UBound(myArray, 1), UBound(myArray, 2)).Value = myArray
End Sub

ReDim of one-dimensional array throws 'Subscript out of Range'

I want to redim an one-dimentional array by "cutting off" the first five entries as they have to be removed for a later logic.
I created a record set from a query
I filled an array recordSet() As Variant (size is 147).
Now: size of recordSet = size of daoRst3
I try to remove the first five elements of the array recordSet.
Code:
Set daoRst3 = gDB.OpenRecordset("SELECT * FROM TEST")
For i = 0 To daoRst3.Fields.Count - 1
ReDim Preserve recordSet(0 To i)
If daoRst3.Fields(i).Value = Empty Then
recordSet(i) = 0
Else: recordSet(i) = daoRst3.Fields(i).Value
End If
Next
'First five values in record set are not needed anymore.
ReDim Preserve recordSet(5 To i - 1)
The last row
ReDim Preserve recordSet(5 To i - 1)
throws "Subscript out of range". I already checked with debugging that i is 148 at this moment.
What might be the problem?
Many thanks in advance!
Alright this time i got it...
Private Sub this()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tmpCardList")
Dim msg As String
Dim myArray() As String
Dim array2() As String
ReDim array2(0 To rs.Fields.Count - 1)
Dim i As Long
For i = 0 To rs.Fields.Count - 1
Debug.Print ; rs.Fields(i).Name
array2(UBound(array2, 1) - i) = rs.Fields(i).Name
Next i
ReDim Preserve array2(UBound(array2) - 5)
ReDim myArray(0 To UBound(array2, 1))
For i = 0 To UBound(array2, 1)
myArray(UBound(array2, 1) - i) = array2(i)
Next i
rs.Close
Set rs = Nothing
End Sub
Turns out you have to write you own custom thing to sort the array. A little bit of an extra hoop. Just realized the final output is reversed but you could easily "undo" that by replicating my initial reversing logic.
Final Edit - this time with less typing - WOOHOO

Resources