I have a list - that I just found this syntax that will permit multi-selects from my list:
Dim Oldvalue As String
Dim Newvalue As String
On Error GoTo Exitsub
If Target.Address = "$B$1" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
I can tell that the List of values selected will be stored in the variable Target.Value - but how do I:
1) Check the length of Target.Value (so I know if I have 1 selected or multi?)
2) Iterate each selection?
Without assigning an array you can use
Target.Rows.Count 'number of rows
Target.Columns.Count 'number of columns
Target.Cells.Count 'number of cells
You can loop through them using indices or
Dim cl As Range
For Each cl In Target.Cells 'For Each loops are much faster then looping using indices
'do something with cl
Next cl
Also note Thomas Inzina's comment that this way you will get all the cells even if you have a discontinuous Range.
Edit: The For Each loop is faster that looping through the cells using indices, i.e.
For i = 1 To Target.Rows.Count
For j = 1 To Target.Columns.Count
'do something with Target.Cells(i, j)
Next j
Next i
Using an array as luke_t suggested might be even faster.
You need to assign Target.Value to a Variant variable. Remember to include parentheses after the variable name, to denote that you're assigning an Array.
You can then find the dimensions of the array using LBound and UBound, you can also iterate through the array. Pretty sure this is what you're trying to do.
Sub get_vals()
Dim arr() As Variant
Dim i As Long
arr = Range("A1:A5").Value
Debug.Print UBound(arr, 1) ' Print rows
Debug.Print UBound(arr, 2) ' Print columns
For i = LBound(arr, 1) To UBound(arr, 1) ' Iterate through the rows of the array
Debug.Print arr(i, 1)
Next i
End Sub
Edit
As raised, you would not be able to assign a one cell range to a Array Variant. You may wish to just use Dim arr As Variant. This will allow you to assign a single cell range to the variable. You can then check the type to determine if you need to iterate an array or just work with a single string/integer.
If TypeName(arr) = "Variant()" Then
' Iterate
Else
' Work with single string/integer
End If
Related
Is there a quick way to check whether a whole row of a variant is empty?
My multi-dimensional array / variant has n-rows and m-columns.
The only way I can think of is to loop through the columns (of a specific row) and use the IsEmpty() function to determine if a cell is empty.
The variant only consists strings.
Do you know a faster way? Maybe something like this pseudo-code: IsEmpty(myarr(1,*))
this pseudocode would mean to check the all columns of the first row if they are empty.
You could try something like:
Sub Test()
Dim myarr() As Variant, indx As Long
myarr = Range("A8:C20").Value 'Or however you initialize your array.
indx = 1 'Or whichever row you would want to check.
With Application
Debug.Print Join(.Index(myarr, indx, 0), "") <> ""
End With
End Sub
Not sure if it will be faster than a loop though, since we call a worksheet application.
No, there isn't a faster way especially considering that arrays in VBA are stored column-wise in memory. The values on a single row are not stored adjacent in memory as it's the case with column values - you could easily test this by running a For Each loop on an array.
That being said, you should probably consider having a Function that checks if a specific row is empty so that you can call it repeatedly and maybe also check for null strings if needed. For example a range of formulas returning "" will not be empty but you might want to have the ability to consider them empty.
For example, you could use something like this:
Public Function Is2DArrayRowEmpty(ByRef arr As Variant _
, ByVal rowIndex As Long _
, Optional ByVal ignoreEmptyStrings As Boolean = False _
) As Boolean
Const methodName As String = "Is2DArrayRowEmpty"
'
If GetArrayDimsCount(arr) <> 2 Then
Err.Raise 5, methodName, "Array is not two-dimensional"
ElseIf rowIndex < LBound(arr, 1) Or rowIndex > UBound(arr, 1) Then
Err.Raise 5, methodName, "Row Index out of bounds"
End If
'
Dim j As Long
Dim v As Variant
'
For j = LBound(arr, 2) To UBound(arr, 2)
v = arr(rowIndex, j)
Select Case VBA.VarType(v)
Case VbVarType.vbEmpty
'Continue to next element
Case VbVarType.vbString
If Not ignoreEmptyStrings Then Exit Function
If LenB(v) > 0 Then Exit Function
Case Else
Exit Function
End Select
Next j
'
Is2DArrayRowEmpty = True 'If code reached this line then row is Empty
End Function
Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
If Not IsArray(arr) Then Exit Function
'
Const MAX_DIMENSION As Long = 60
Dim dimension As Long
Dim tempBound As Long
'
'A zero-length array has 1 dimension! Ex. Array() returns (0 to -1)
On Error GoTo FinalDimension
For dimension = 1 To MAX_DIMENSION
tempBound = LBound(arr, dimension)
Next dimension
Exit Function
FinalDimension:
GetArrayDimsCount = dimension - 1
End Function
Notice that I haven't checked for IsObject as your values are coming from a range in Excel but you would normally check for that in a general case.
Your pseudocode IsEmpty(myarr(1,*)) could be translated to:
Is2DArrayRowEmpty(myarr, 1, False) 'Empty strings would not be considered Empty
or
Is2DArrayRowEmpty(myarr, 1, True) 'Empty strings would be considered Empty
I am trying to write a process that compares strings and deletes the duplicate string within a given column using a selection as the top and bottom constraints.
Most of the process of checking and deleting works however I am having trouble with moving the cell contents up a cell after the duplicate string was deleted.
Image showing how the script should work
Red outline is the loop that selects the String to compare against.
Green outline is the loop that finds, deletes and moves the cells up one.
Blue outline is the Selection.
Stage 1 is to find and compare two strings that are the same.
Stage 2 is to delete the string that is the same as the first string.
Stage 3 is to move everything under the deleted cell with the deleted string up one row so that there is no empty cell.
I'm having problems with stage 3. I don't know how to move all data in those cells up one row without using a loop and I can't use the selection.
Here is the code so far:
Private Sub Tabeller()
Dim vRngMv As Variant
Dim iRowChsr1, iRowChsr2, iRowTtl, iI As Integer
Dim vRowIn, vRowComp As String
Dim oRngSlct, oRngMv As Range: Dim ws As Worksheet: Dim oBS As Object
'Newer Version will get rid of Selection as range determination
'Why does oRngSlct become a Variant/Object/Range here and oRngMv stays a Range object?
'I dont use it, kept it in to ask the question.
Set oRngMv = Selection: Set oRngSlct = Selection
iRowTtl = oRngSlct.Rows.Count
'First Loop For holding target cell data for comparison
For iRowChsr1 = 1 To iRowTtl
'Chooses target cell and string
vRowIn = oRngSlct(iRowChsr1, 1)
'Second loop for Seeking a matching String
For iRowChsr2 = 1 To iRowTtl
'Check to not pick itself
If iRowChsr1 = iRowChsr2 Then
'Offsets Counter by 1 if it enocunters itself
iRowChsr2 = iRowChsr2 + 1
Else
'Sets comparison string
vRowComp = oRngSlct(iRowChsr2, 1)
'String comparison
iI = StrComp(vRowIn, vRowComp, 1)
'If strings are equal
If iI = 0 Then
'Deletes; I know this is redundant but its here for clarity
oRngSlct(iRowChsr2, 1) = ""
'Offsets by iRowChsr by 1
iRowChsr2 = iRowChsr2 + 1
'Create Variant with proper range, it just has to be translated into something that excel can move.
vRngMv = Range((oRngSlct(iRowChsr2, 1)), (oRngSlct(iRowTtl, 1)))
Set oRngMv = Range 'I know this doesnt work
'Offsets back to original Position of Deleted cell
iRowChsr2 = iRowChsr2 - 1
'*******************************
'*Cuts and pastes or moves here*
'*******************************
End If
End If
'Next Comparison String
Next iRowChsr2
'Next target String
Next iRowChsr1
End Sub
Unique (Remove Duplicates)
You could rather use one of the following.
The first solution will leave error values and blanks as part of the resulting data, while the second one will remove them.
The Code
Option Explicit
Sub removeDupesColumnSelection()
' Validate Selection.
If TypeName(Selection) <> "Range" Then Exit Sub
' Remove duplicates.
Selection.Columns(1).RemoveDuplicates Array(1), xlNo
End Sub
Sub uniquifyColumnSelection()
' Validate Selection.
If TypeName(Selection) <> "Range" Then Exit Sub
' Write values from first column of Selection to Data Array.
Dim rg As Range: Set rg = Selection.Columns(1)
Dim rCount As Long: rCount = rg.Rows.Count
Dim Data As Variant
If rCount > 1 Then
Data = rg.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
End If
' In Unique Dictionary...
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
' Write unique values from Data Array to Unique Dictionary.
Dim Key As Variant
Dim i As Long
For i = 1 To rCount
Key = Data(i, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
.Item(Key) = Empty
End If
End If
Next i
ReDim Data(1 To rCount, 1 To 1)
If .Count > 1 Then
' Write values from Unique Dictionary to Data Array.
i = 0
For Each Key In .Keys
i = i + 1
Data(i, 1) = Key
Next Key
End If
End With
' Write values from Data Array to Destination Range.
rg.Value = Data
End Sub
I'm trying to find out any way to kick out unwanted items from a list. For example, I wish to get rid of 47 and 90 from the list as they do not meet the condition. I've used Delete within the script which is definitely not the right keyword. However, consider it a placeholder.
I've tried with:
Sub DeleteItemConditionally()
Dim numList As Variant, elem As Variant
numList = Array("12", "47", "90", "15", "37")
Debug.Print UBound(numList) - LBound(numList) + 1
For Each elem In numList
If elem >= 40 Then
Delete elem
End If
Next elem
Debug.Print UBound(numList) - LBound(numList) + 1
End Sub
Expected result:
First print : 5 (already getting it)
Second print: 3 (want to achieve it)
Adding and removing additional elements to arrays is rather slow. And changing dimensions of arrays with Redim is one of the slowest operations in VBA. Anyway, if we are talking about up to a decent number of cases, then the speed is ok:
Option Explicit
Sub DeleteItemConditionally()
Dim numList As Variant
numList = Array(12, 47, 90, 15, 3)
Dim newElements() As Variant
Dim firstElement As Boolean: firstElement = True
Dim i As Long
For i = LBound(numList) To UBound(numList)
If numList(i) <= 40 Then
If firstElement Then
ReDim Preserve newElements(0)
firstElement = False
Else
ReDim Preserve newElements(UBound(newElements) + 1)
End If
newElements(UBound(newElements)) = numList(i)
End If
Next
Dim element As Variant
For Each element In newElements
Debug.Print element
Next
End Sub
With a Collection or with System.Collections.ArrayList as in the case below, the optimization and the speed would be way faster (but still slightly invisible, if the data is not more than a few hundred items). Additionally, a collection could be sorted rather quickly and then the speed of the task will be even better:
Sub TestMyCollection()
Dim myList As Object
Set myList = CreateObject("System.Collections.ArrayList")
With myList
.Add 12
.Add 47
.Add 90
.Add 15
.Add 3
End With
myList.Sort
Dim i As Long
For i = myList.Count - 1 To 0 Step -1
If Not myList.Item(i) <= 40 Then
myList.RemoveAt i
End If
Next i
Dim element As Variant
For Each element In myList
Debug.Print element
Next
End Sub
Additionally, to increase performance and to get some good usage of the .Sort() after the first number, bigger than 40 the For i = myList.Count - 1 To 0 Step -1 could exit.
If you are using a single dimension array to represent a list then you will be much better served by replacing your array with a collection (or if you wish to be more advanced a Scripting.Dictionary).
If you replace your array with a collection then essentially you don't need to make any significant changes to your code. Just a few minor tweaks to compensate for the fact that you can't query a collection to get the index of an item so you have to iterate by index rather than by item in your particular case.
I've updated your code to add a function that replaces the Array method by returning a populated Collection, and updates the loop to use indexing. You should also note that the indexing loop counts down. This is because if we remove an item from a collection, the size will no longer be the count we obtained at the start of the loop.
Sub DeleteItemConditionally()
Dim my_num_list As Collection, my_item_index As Long
Set my_num_list = FilledCollection("12", "47", "90", "15", "37")
Debug.Print my_num_list.Count
For my_item_index = my_num_list.Count To 1 Step -1
If my_num_list(my_item_index) >= 40 Then
my_num_list.Remove my_item_index
End If
Next
Debug.Print my_num_list.Count
End Sub
Public Function FilledCollection(ParamArray args() As Variant) As Collection
Dim my_return As Collection
Dim my_item As Variant
Set my_return = New Collection
For Each my_item In args
my_return.Add my_item
Next
Set FilledCollection = my_return
End Function
Note: This answer focuses on the question asked: how to conditionally delete items from an Array. Other answers deal with some of the many alternatives.
Your data. You've created an array of Strings then compared them to a Number. That won't work (well, it will give an answer, but it won't be what you expect). I've changed your data to Numbers
I've created the Delete functionality as a Function that returns a possibly reduced array. It only accepts 1D arrays (if anythig else is passed, the passed parameter is returned)
I've borrowed a couple of Utility Functions from CPearson.Com - BTW thats a great resource for all things VBA
I've included some flexibility for the test type, (>= or <) - you could add more if you want.
Speed. Whether or not this is fast enough depends on your use case. I've tested it as follows - Array Size of 5 run 1000 time in 3.9 mS. Array size of 10,000 runs 1000 times 586 mS
Included is an alternate version that can apply several of multiple conditions, >, >= <, <= a value must pass all tests to be kept (obviously, only certain conbinations make sence)
Sub Test()
Dim numList As Variant
numList = Array(12, 47, 90, 15, 37)
Debug.Print UBound(numList) - LBound(numList) + 1
numList = DeleteItemConditionally(numList, 40) ' Delete >= 40
Debug.Print UBound(numList) - LBound(numList) + 1
End Sub
' Only 1 condition may be supplied
Function DeleteItemConditionally(Arr As Variant, Optional DeleteGEQ As Variant, Optional DeleteLES As Variant) As Variant
Dim NewArr As Variant
Dim iArr As Long, iNewArr As Long
' Check if Arr is valid
If Not IsArrayAllocated(Arr) Then GoTo AbortExit
If NumberOfArrayDimensions(Arr) <> 1 Then GoTo AbortExit
' that one and only one of Delete criteria is specified
If Not (IsMissing(DeleteGEQ) Xor IsMissing(DeleteLES)) Then GoTo AbortExit
ReDim NewArr(LBound(Arr) To UBound(Arr))
If Not IsMissing(DeleteGEQ) Then
' Delete members >= DeleteGEQ
iNewArr = LBound(Arr) - 1
For iArr = LBound(Arr) To UBound(Arr)
If Arr(iArr) < DeleteGEQ Then
iNewArr = iNewArr + 1
NewArr(iNewArr) = Arr(iArr)
End If
Next
Else
' Delete members < DeleteGEQ
iNewArr = LBound(Arr) - 1
For iArr = LBound(Arr) To UBound(Arr)
If Arr(iArr) >= DeleteGEQ Then
iNewArr = iNewArr + 1
NewArr(iNewArr) = Arr(iArr)
End If
Next
End If
' ReDim Preserve is an expensive function, do it only once
ReDim Preserve NewArr(LBound(Arr) To iNewArr)
DeleteItemConditionally = NewArr
Exit Function
AbortExit:
On Error Resume Next
DeleteItemConditionally = Arr
End Function
' Several conditions may be supplied
Function DeleteItemConditionally2(Arr As Variant, Optional KeepGEQ As Variant, Optional KeepGRT As Variant, Optional KeepLEQ As Variant, Optional KeepLES As Variant) As Variant
Dim NewArr As Variant
Dim iArr As Long, iNewArr As Long
Dim Keep As Boolean
' Check if Arr is valid
If Not IsArrayAllocated(Arr) Then GoTo AbortExit
If NumberOfArrayDimensions(Arr) <> 1 Then GoTo AbortExit
ReDim NewArr(LBound(Arr) To UBound(Arr))
iNewArr = LBound(Arr) - 1
For iArr = LBound(Arr) To UBound(Arr)
Keep = True
If Not IsMissing(KeepGEQ) Then
' Keep members >= KeepGEQ
If Arr(iArr) < KeepGEQ Then
Keep = False
End If
End If
If Keep And Not IsMissing(KeepGRT) Then
' Keep members > KeepGRT
If Arr(iArr) <= KeepGRT Then
Keep = False
End If
End If
If Keep And Not IsMissing(KeepLEQ) Then
' Keep members <= KeepLEQ
If Arr(iArr) > KeepLEQ Then
Keep = False
End If
End If
If Keep And Not IsMissing(KeepLES) Then
' Keep members < KeepLES
If Arr(iArr) >= KeepGRT Then
Keep = False
End If
End If
If Keep Then
iNewArr = iNewArr + 1
NewArr(iNewArr) = Arr(iArr)
End If
Next
' ReDim Preserve is an expensive function, do it only once
ReDim Preserve NewArr(LBound(Arr) To iNewArr)
DeleteItemConditionally2 = NewArr
Exit Function
AbortExit:
On Error Resume Next
DeleteItemConditionally2 = Arr
End Function
Public Function IsArrayAllocated(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayAllocated
' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been
' sized with Redim) or FALSE if the array is not allocated (a dynamic that has not yet
' been sized with Redim, or a dynamic array that has been Erased). Static arrays are always
' allocated.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is just the reverse of IsArrayEmpty.
'
' From http://www.cpearson.com/Excel/VBAArrays.htm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
On Error Resume Next
' if Arr is not an array, return FALSE and get out.
If IsArray(Arr) = False Then
IsArrayAllocated = False
Exit Function
End If
' Attempt to get the UBound of the array. If the array has not been allocated,
' an error will occur. Test Err.Number to see if an error occurred.
N = UBound(Arr, 1)
If (Err.Number = 0) Then
''''''''''''''''''''''''''''''''''''''
' Under some circumstances, if an array
' is not allocated, Err.Number will be
' 0. To acccomodate this case, we test
' whether LBound <= Ubound. If this
' is True, the array is allocated. Otherwise,
' the array is not allocated.
'''''''''''''''''''''''''''''''''''''''
If LBound(Arr) <= UBound(Arr) Then
' no error. array has been allocated.
IsArrayAllocated = True
Else
IsArrayAllocated = False
End If
Else
' error. unallocated array
IsArrayAllocated = False
End If
End Function
Public Function NumberOfArrayDimensions(Arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
'
' From http://www.cpearson.com/Excel/VBAArrays.htm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
Ndx = Ndx + 1
Res = UBound(Arr, Ndx)
Loop Until Err.Number <> 0
NumberOfArrayDimensions = Ndx - 1
End Function
I have been working on a macro that summarizes the data from multiple sheets in my workbook. In order to know which columns to use in my summary sheet I need to first extract all the unique values from the first column in my sheets.
The idea is that it will loop through the sheets and define a range, then it will loop through each cell in the range, check if the value of that cell is already in the array and if not copy and paste it and add it to the array.
Unfortunately I get an the error "Index outside of valid Area" for the line that is supposed to add the cell value to the array.
ReDim Preserve uniqueVal(1 To UBound(uniqueVal) + 1) As Variant
I took that specific code from the question https://superuser.com/questions/808798/excel-vba-adding-an-element-to-the-end-of-an-array .
Here is the entire code for reference.
Private Sub CommandButton24_Click()
Dim xSheet As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim copyRng As Range
Dim destRng As Range
Dim cRange As Range
Dim c As Range
Dim uniqueVal() As Variant
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Delete the summary worksheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Summary").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' Add a worksheet with the name "Summary"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Summary"
Set destRng = DestSh.Range("A1")
'Define inital array values
uniqueVal = Array("Account by Type", "Total")
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each xSheet In ActiveWorkbook.Worksheets
If InStr(1, xSheet.Name, "ACCOUNT") And xSheet.Range("B1") <> "No Summary Available" Then _
Set copyRng = xSheet.Range("A:A")
For Each c In copyRng.SpecialCells(xlCellTypeVisible)
If Len(c) <> 0 And Not ISIN(c, uniqueVal) Then _
'Copy to destination Range
c.Copy destRng
'move destination Range
Set destRng = destRng.Offset(0, 1)
'change / adjust the size of array
ReDim Preserve uniqueVal(1 To UBound(uniqueVal) + 1) As Variant
'add value on the end of the array
uniqueVal(UBound(uniqueVal)) = c.Value
End If
Next c
End If
Next xSheet
ExitTheSub:
Application.Goto DestSh.Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Per default, arrays in Excel VBA start with the index 0, not the index 1. You can test this by checking your arrays contents: your first string "Account by Type" should be on uniqueval(0) rather than on uniqueval(1).
Two ways to solve this:
add Option Base 1 to the top of your module or
change ReDim Preserve uniqueval(1 To UBound(uniqueval) + 1) to ReDim Preserve uniqueval(0 To UBound(uniqueval) + 1)
It's up to you which one you chose, but imo the latter is cleaner, since you don't have to fiddle with array options on module level.
As I see it, you're not actually using the arrays' contents yet. If you do later on, just loop For i = LBound(uniqueval) To UBound(uniqueval) - in which case it is irrelevant with what option you went.
On the first loop uniqueVal has no Ubound. That's why it fails. So, you should first Redim it as Redim uniqueVal(1 To 1), then write to the Ubound and increase the size thereafter. That would always leave you with a blank element at the top which you can remove at the end.
The better (because it runs faster) is to Dim uniqueVal to a possible max number, then set the current index with a counter, like i = i + 1, and do a Redim Preserve uniqueVal(i) at the end, thereby cutting off all unused elements.
The underscore at the end of a line of code means that the line is continued, logically, in the next line. For example,
If 1 <> 2 Then _
Debug.Print "All is well"
This is the same as If 1 <> 2 Then Debug.Print "All is well"
Observe, however, that there is no End If. If there were more than one command to follow the Then you must use End If, for example,
If 1 <> 2 Then
Debug.Print "All is well"
A = 3
End If
Here, everything between If and End If will only be executed if 1 <> 2. This is the case with If Len(c) <> 0 And Not ISIN(c, uniqueVal) Then _. Once the error of the UBound is cured this one will stop your code from running. Remove the underscore following the Then.
I'm in SAP, trying to dump an array of GuiLabel s into a jagged array.
First I parse the child's ID to get the row and column while filtering out non-GuiLabel objects.
This part works.
I created a variant array that represents the lines, in each line element I put an array of strings representing each 'label columns'.
This part seems to work with no errors
The problem occurs when I try to read back from this first variant array.
I followed this great thread -> How do I set up a "jagged array" in VBA?
and by the end of it, it seems I should be able to read each of my elements with a simple Debug.Print myRows(0)(0) , however I get a type mismatch !
Any advice appreciated !
Function LabelToArray(LblCollection As Variant) As Variant()
Dim myid As String
Dim mycolumn As String
Dim myrow As String
Dim intLastRow As Integer
Dim intLastCol As Integer
Dim myRows As Variant
Dim myColumns() As String
' Create first row
ReDim myRows(0)
' For every child object in the collection
For Each mychld In LblCollection
' Only execute for labels
If mychld.Type = "GuiLabel" Then
' Get column and row of current label
myid = Split(mychld.ID, "[")(4)
myid = Mid(myid, 1, Len(myid) - 1)
mycolumn = Split(myid, ",")(0)
myrow = Split(myid, ",")(1)
' New row ? Reset column counter, set row counter and redim the array of rows
' This will fail spectacularly if SAP stop giving rows in numerical order
If myrow > intLastRow Then intLastCol = 0: intLastRow = myrow: ReDim myRows(myrow)
' Reset or resize this line's columns array
If intLastCol = 0 Then
' Set filled out 'myColumns' array into correct 'myRows' object
If myrow <> 0 Then myRows(myrow - 1) = myColumns
' testing, print last column in this row
If myrow <> 0 Then Debug.Print myColumns(UBound(myColumns))
' testing, print first column in this row
If myrow <> 0 Then Debug.Print myColumns(0)
' testing, print number of columns
If myrow <> 0 Then Debug.Print UBound(myColumns)
' Reset myColumns array because we're on a new line
ReDim myColumns(0)
Else
ReDim Preserve myColumns(intLastCol)
End If
myColumns(intLastCol) = mychld.Text
intLastCol = intLastCol + 1
'Debug.Print mycolumn & "," & myrow
End If
Next
' Copy last row into array
myRows(myrow) = myColumns
' SEEMS TO WORK FINE UP TO THIS POINT !
Debug.Print UBound(myRows)
Debug.Print myRows(0)(0) 'THIS LINE FAILS, TYPE MISMATCH (run-time error 13) ! I also tried cstr(myRows(0)(0))
LabelToArray = myRows
End Function
That error is thrown if the second dimension does not exist. My money would go on that as your problem.
Here's an example of an array of jagged arrays, the last being empty. The last line will throw a Type Mismatch error because there is no second dimension.
Dim mainArray(0 To 3) As Variant
Dim subArray As Variant
subArray = Array("A", "B", "C")
mainArray(0) = subArray
Debug.Print mainArray(0)(0)
'prints A
subArray = Array(1, 2, 3, 4)
mainArray(1) = subArray
Debug.Print mainArray(1)(0)
'prints 1
subArray = Split("HELLO|WORLD", "|")
mainArray(2) = subArray
Debug.Print mainArray(2)(0)
'prints HELLO
mainArray(3) = Empty
Debug.Print mainArray(3)(0)
'Type mismatch
Have a look in your Locals Window and test if your arrays are correct.
As noted in the comments, that ReDim without Preserve looks suspicious - I think you may be clearing your old arrays.