Count number of non-empty fields in Excel VB array's column - arrays

Question

I currently read a 2-dimensional range into an Excel VBA array like so:
Set Ws = Sheet1
Ws.Activate
LastRow = Ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
LastCol = Ws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
ReDim elements(0 To LastRow - 2, 0 To LastCol - 2)
elements = Ws.Range(Cells(2, 1), Cells(LastRow, LastCol))
The range is 25 rows by 11 columns. However, not all cells in the range have values so some of the values in the array are 'empty'.
col A has 25 items
col B has 16
col K has 12...
I need to loop through this array and create a second array, which will be a "Cartesian product" of the values from the first one. In order to determine how many times I need to loop I need to figure out how many items there are in each of the arrays columns ("dimensions"?).
Here is an attempt of my loop:
Row = 0
For i = 1 To 25 'numElements in column 1
For j = 1 To 3 'numElements in column 6
For k = 1 To 5 'numElements in column 7
For l = 1 To 14 'numElements in column 8
For m = 1 To 6 'numElements in column 10
For n = 1 To 12 'numElements in column 11
cartesian(Row, 0) = elements(i, 0)
cartesian(Row, 1) = elements(i, 1)
cartesian(Row, 2) = elements(i, 2)
cartesian(Row, 3) = elements(i, 3)
cartesian(Row, 4) = elements(i, 4)
cartesian(Row, 5) = elements(j, 5)
cartesian(Row, 6) = elements(k, 6)
cartesian(Row, 7) = elements(l, 7)
cartesian(Row, 8) = elements(l, 8)
cartesian(Row, 9) = elements(m, 9)
cartesian(Row, 10) = elements(n, 10)
Row = Row + 1
Next n
Next m
Next l
Next k
Next j
Next i
Any help appreciated :)
EDIT 1:
This is the range that I read into array1:
Austria sem jan
Belgium gdn feb
France mar
US apr
may
jun
I need to be able to count how many "items" there are in column 1, column 2 and column 3 in order to multiply them. That way I will know how big I need to ReDim second array.
This is what I need in the array 2 and to finally write back into another sheet:
Austria sem jan
Austria sem feb
Austria sem mar
Austria sem apr
Austria sem may
Austria sem jun
Austria gdn jan
Austria gdn feb
Austria gdn mar
Austria gdn apr
Austria gdn may
Austria gdn jun
Belgium sem jan
Belgium sem feb
Belgium sem mar
Belgium sem apr
Belgium sem may
Belgium sem jun
Belgium gdn jan
Belgium gdn feb
Belgium gdn mar
Belgium gdn apr
Belgium gdn may
Belgium gdn jun
etc.

Answer 1

This should do it like you need it in a decent amount of time... still will take some time for ~300k entries:
Option Explicit
Sub getMyList()
'set input
Dim inputVal As Variant
'get input values
With ThisWorkbook.Worksheets("Sheet1")
inputVal = .Range(.Cells(1, 1), .Cells(.Cells.Find("*", , , , 1, 2).Row, .Cells(1, 1).End(xlToRight).Column)).Value
End With
'set count array
Dim xCounts() As Variant
ReDim xCounts(1 To UBound(inputVal, 2))
Dim i As Long, j As Long
For i = 1 To UBound(xCounts)
j = 1
While inputVal(j, i) <> "" And j < UBound(inputVal)
j = j + 1
Wend
'xCounts(i) = j - 1 'will skip last value if it is at the last row
xCounts(i) = j + (inputVal(j, i) = "") 'new one will work as wanted
Next
'set output sizes
Dim outVal() As Variant
ReDim outVal(1 To Application.Product(xCounts), 1 To UBound(xCounts))
'runner sets
Dim colRunner As Long, rowRunner As Long, copyRunner As Long
Dim itemRep As Long, listRep As Long
For colRunner = 1 To UBound(xCounts)
rowRunner = 1
itemRep = 1
listRep = 1
'repeat whole list
For i = 1 To colRunner - 1
listRep = listRep * xCounts(i)
Next
'repeat each item
For i = colRunner + 1 To UBound(xCounts)
itemRep = itemRep * xCounts(i)
Next
'run the list for output
copyRunner = 1
For i = 1 To listRep
For copyRunner = 1 To xCounts(colRunner)
For j = 1 To itemRep
outVal(rowRunner, colRunner) = inputVal(copyRunner, colRunner)
rowRunner = rowRunner + 1
Next
Next
Next
Next
'output everything
ThisWorkbook.Worksheets("Sheet2").Cells(1, 1).Resize(UBound(outVal), UBound(outVal, 2)).Value = outVal
End Sub
The code should be easy to read (there is no real magic inside) :P
However, if any questions are left, just ask :)
EDIT
The xCounter simply hold the counts of all items for each column because this numbers are used lots of times.
For clarification: Let's assume you have a list like this:
A B C D E
1 1 1 1 1
2 2 2 2 2
3 3 3 3
4 4 4
5 5 5
6 6 6
7 7
8
(Used numbers for easy counting, also works with any strings)
xCounter will now be {8,2,6,7,3}. Now if you want to write down the column C then you need to know how many times each item needs to be repeated. This can be calculated by multiplying the counts of all columns which come later. For this case it would be 7 * 3 = 21 times. Also, you need to know how many items are in the list to loop through which will be 6. Then the whole list also needs to repeat itself which can be calculated by multiplying all counts of rows which are in front of it. That would be 8 * 2 = 16 times. This way also the 3 inner For ... Next loops are build up. ListRepeat(EachItem(ItemRepeat)).
To know which line in the output array is to be written you need a simple up counting value which is the RowCounter. Doing this directly into the sheet you would use a range which simply offsets one row down every time a value is written in a cell.
By this system you do every column completely seperated from the others because all you need are the products of the item counts of the leading and following columns (for which we have xCounter). Still we need to do this for each column so the outer loop is the column (colRunner).
Simply for not getting confused by having 4 loops using i, j, k, l inside each other I renamed the "runner" for the rows in the outVal to rowRunner and the one for the columns to colRunner. Having the upper and lower limits for the repeats directly set in front of the inner loops, I stayed with i and j. (Also they are not used for anything in that loops, they simply ensure the repeats by doing the same action mutiple times)
If I missed something or other questions pop up, just do it as it is always the right thing to do: ask. ;)