I am using Libre Calc with a horizontal table like below
a
b
c
d
e
f
g
h
I
j
0.1
0.7
2.3
5
And i would like to list values greater than 0 like below
Name
Value
b
0.1
e
0.7
f
2.3
g
5
I have tried to use INDEX and MATCH with no success How to use Index to find all values greater than
=INDEX($R$4:$R$13,MATCH(1,($S$4:$S$13>0)*(COUNTIF($U$3:U3,$R$4:$R$13)=0),0))
I have also tried to create a separate Transpose of table and then run the above command with limited success.
This task can be accomplished in several different ways.
The first option (which you tried) is with a long and obscure formula. More precisely, two formulas - the first will select the names of the columns that should be displayed, the second will pull the necessary values into the resulting table using the selected names (this can be an ordinary HLOOKUP())
(By the way, the formula that you tried to use is already morally outdated - now Excel has a FILTER() function, which, in combination with the TRASPOSE() function, will give the desired result much easier. Let's hope that Calc will soon also get functions like FILTER(), UNIQUE() and others)
Another way is to manually copy the original range, paste it into a new location using Paste Special (Ctrl+Shift+V) with the Transpose and Link options enabled, and then filter the resulting auxiliary range using the usual Standard filter, copying the filtering result to the specified location.
I prefer the third way - UDF, User-defined function. The task is quite simple, the usual movement of data from place to place. Therefore, the algorithm is also simple and the macro code too:
Function TransposeAndFilter(aData As Variant) As Variant
Dim aResult As Variant
Dim lB1 As Long, uB1 As Long
Dim lB2 As Long, uB2 As Long
Dim i As Long, j As Long, nextRow As Long
lB1 = LBound(aData, 1) : UB1 = UBound(aData, 1)
lB2 = LBound(aData, 2) : UB2 = UBound(aData, 2)
ReDim aResult(lB2 To uB2, lB1 To uB1)
nextRow = lB2 - 1
For i = lB2 To uB2
If aData(uB1,i) > 0 Then
nextRow = nextRow + 1
For j = lB1 To uB1
aResult(nextRow, j) = aData( j, i)
Next j
EndIf
Next i
TransposeAndFilter = aResult
End Function
Write in a cell a formula like as =TRANSPOSEANDFILTER(A1:I2) and press Ctrl+Shift+Enter
Related
I'm trying to generate a binomial tree for option evaluation, and I want to draw a lattice using values that comes from an array where values are already there.
So basically I have an array in my VBA that ressemble to this:
My array in vba
And I want to paste in an Excel sheet in this form:
How i want to paste in my worksheet
I don't necessarily ask for a code, I would just like to have an idea of the algorithm used to create the tree. I really tried to see any pattern and couldn't find.
What I identified is that if the number of columns of the array is (n+1), then then number of rows will be (2n-1).
Thanks in advance
This might give you an idea. You would need to tweak it if your array is not 1-based:
Sub InsertTree(Nodes As Variant, RootNode As Range)
'Assumes that Nodes is a 1-based array
'That has data 1-element in its first
'column, 2 in its second, etc. And that RootNode
'Has been chosen so that there is enough room
'for the tree
Dim i As Long, j As Long, n As Long
Dim TopNode As Range 'top node in each column
n = UBound(Nodes, 2)
Set TopNode = RootNode
For j = 1 To n
For i = 1 To j
TopNode.Offset(2 * (i - 1)).Value = Nodes(i, j)
Next i
If j < n Then Set TopNode = TopNode.Offset(-1, 1)
Next j
End Sub
As a test, I set my spreadsheet up so that beginning at A1 I had:
a b d g
c e h
f i
j
Then I ran:
InsertTree Range("A1:D4").Value,Range("F10")
And the result looks like this:
I am looking for a marcro that can copy and paste cells.
The value of cell X must be copied to a cell X + 6.
So A1 text "Xteam" has to be copied to cell A7, this up to cell A380.
The same applies to cell B2 + 6.
It has to be dynamic, so the cell and sequence are dynamic..
I want to be able to indicate for myself which cell it is and the sequence ..
How can I do this,
I have this but doesnot work like i want:
Sub sequence()
Const Nxt As Long = 7
Dim A As Variant, B As Variant, V As Variant, N As Long
A = Range("A1").Value
B = Range("B2").Value
ReDim V(Nxt To 380, 1 To 2)
For N = Nxt To 380
If N Mod 6 = 1 Then
V(N, 1) = A
V(N + 1, 2) = B
End If
Next N
Application.ScreenUpdating = False
Range("A" & Nxt, "B380").Value = V
Application.ScreenUpdating = True
End Sub
thank you in advance
elmalle
Ok well, this is under the assumption that you want to specify how many times you want to copy A1 and B2 down the sheet. So your loop is fairly confusing, instead of using MOD, since you know you want it every 6 spaces and you're not doing anything to the other cells, it's easier just to have the number multiplied by 6 for your indexing. This also helps you figure out the dimensions of your transfer arrays more easily since you want to specify how many times you want to copy.
It's also worth noting that you're Application.screenupdating = False is in the wrong place. The real place you would want to speed up is during the loop. So if you were to include it, I would put it near the top of the code, but this isn't very resource intensive so I've just left it out.
Normally it's good to dim Constants if it helps with the legibility of the code, but in this case it doesn't seem to add any clarity. An example where it could help is where you're changing the colour of cells and are using colour indices. Constant Red as long = 3 makes it a lot more understandable, whereas constant Nxt as long = 7 doesn't add much.
Instead of working with a 2-D array dealing with both A and B at once, I chose to use two column vectors because it makes the pasting easier since they are staggered and it simplifies the math since you don't need to have items on staggered rows.
Lastly, I can't advocate this enough, but please, please, please use names that make sense at a glance. Although it may not have made a huge difference in this case, if you get to a more complicated project people might look at it and have to wonder what V is even used for. It also just makes it easier for people to help you since they won't have to sit for a bit wondering what each variable means.
I've also specified the worksheet it looks at, so currently it'll only look at the first sheet as indicated by the index 1. Make sure you change that so it changes the correct sheet.
Hope this helped and welcome to Stack Overflow.
Option Explicit
Sub sequence()
Dim A As Variant
Dim B As Variant
Dim N As Long
Dim ArrA() As Variant
Dim ArrB() As Variant
Dim NumCopies As Long
A = Range("A1").Value
B = Range("B2").Value
NumCopies = 100
ReDim Preserve ArrA(1 To NumCopies * 6, 1 To 1)
ReDim Preserve ArrB(1 To NumCopies * 6, 1 To 1)
For N = 1 To NumCopies
ArrA(N * 6, 1) = A
ArrB(N * 6, 1) = B
Next N
Worksheets(1).Range("A2:A" & 1 + NumCopies * 6).Value = ArrA
Worksheets(1).Range("B3:B" & 2 + NumCopies * 6).Value = ArrB
End Sub
I need to reformat a single column (range) of 100+ thousand integers to a user defined matrix of rows and columns. All my online searches have been disappointing in that they're too complicated or not exactly what I need. Index and Offsets won't due because the matrix dimensions (300+ cols, 300+ rows) would be prohibitive for copying over and down. A function would be sufficient that includes the range index, num_cols, num_rows.
Thanks in advance.
So assuming I understand your question (and if not I will withdraw this answer, just let me know), the following entered as an array formula in the spot you want your answer to land should work. InputCol would be where the data now sit. I am not checking sizes and such. You may soup it up to do that. If this is indeed what you want, someone can probably make it do a little better by copying a row (using Application.WorksheetFunction.Transpose) at a time (though I suspect that gets into offset and less readability).
Function SoTest(ByRef inputCol As range, NumRows As Long, NumCols As Long) As Variant
Dim NewMatrix() As Variant
Dim i, j, k As Long
ReDim NewMatrix(1 To NumRows, 1 To NumCols)
k = 1
For i = 1 To NumRows
For j = 1 To NumCols
NewMatrix(i, j) = inputCol(k, 1)
k = k + 1
Next j
Next i
SoTest = NewMatrix
End Function
I sometimes work with symmetric matrices in MS-Excel (both v2007 and v2003).
Is there an option to help me to copy expressions from the lower triangle to the upper one?
It should be something like copy and paste/transponse but those functions normally work only with rectangular areas.
in the added picture you can see an exemple of an expression that I have to replicate by linking the symmetric value in the superior triangle of the matrix.
To get the number in the appropriate cell, we can use OFFSET and the cell address the forms the base of the table. Note that the formula will produce a *Circular Reference` error if entered in on the diagonal. The formula will work for both sides of the diagonal - you just have to decide which one will hold the data, and which will hold the formula.
Offset takes Row and Column to decide the target. By subtracting the base cell row and column from the current position, we can invert the row and columns, and get the data.
Using your example, with the origin of the table in B2, we end up with the following formula:
=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
you can copy this formula into the cells, and get the reflection. Now you have the number, you can do any calculation you require on the reflection. Using your example, this would make the formula:
=10-OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
Result:
Using INDEX to make it non volatile would change the formula slightly. First, we would need a reference to the entire table, not just the top cell. Second, we would need to add 1 to the row/column calculation, as it refers to the first cell as row/column 1, not an offset of 0 as the previous formula.
=INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
and your example of 10-Cell would become:
=10-INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
As one of the above answers demonstrates, this can be done by using Excel formulas. I however find this to be a very tedious procedure. Especially if this is something you need to do on a regular basis. In that case VBA could save you a lot of time.
The following code will work on a square selection and fill the rest of the matrix no matter if it is the lower- or upper part of the matrix that is pre-filled.
Option Explicit
Sub FillSymetricMatrix()
Dim i As Integer, j As Integer
Dim SelRng As Range
Dim FillArea As String
Dim FRow As Integer
Dim FCol As Integer
Set SelRng = Selection
FRow = SelRng.Rows(1).Row
FCol = SelRng.Columns(1).Column
'Returns information about which area to fill
If ActiveSheet.Cells(FRow + SelRng.Rows.Count - 1, FCol).Value <> vbNullString Then 'Lower filled
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value = vbNullString Then 'Upper empty
FillArea = "Upper"
Else
FillArea = "Error"
End If
Else
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value <> vbNullString Then 'Upper filled
FillArea = "Lower"
Else
FillArea = "Error"
End If
End If
'Determines if the selection is square
If SelRng.Rows.Count <> SelRng.Columns.Count Then FillArea = "Error"
'Fills empty area of the square (symetric) matrix
Select Case FillArea
Case Is = "Upper"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(i + FRow, j + FCol).Value = ActiveSheet.Cells(j + FRow, i + FCol).Value
Next j
Next i
Case Is = "Lower"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(j + FRow, i + FCol).Value = ActiveSheet.Cells(i + FRow, j + FCol).Value
Next j
Next i
Case Else
MsgBox "The procedure cannot be performed on the current selection!"
End Select
End Sub
I guess what you need is a function which returns the "diagonal" value of a square matrix, e.g. for any X(j,k) return X(k,j)
Try this:
Function DIAGONAL(Arg As Range, Reference As Range) As Variant
Dim MyRow As Long, MyCol As Long
If Reference.Rows.Count <> Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrRef)
Else
MyRow = Arg.Row - Reference.Row + 1
MyCol = Arg.Column - Reference.Column + 1
If MyRow < 1 Or MyCol < 1 Or MyRow > Reference.Rows.Count Or MyCol > Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrNA)
Else
DIAGONAL = Reference(MyCol, MyRow)
End If
End If
End Function
once you entered this function in VBA, you can use it inside or outside your square matrix ... you just need to ensure that your argument (parameter: Arg) is within the matrix (parameter: Reference) ... or you get an #N/A error. Or you get a #REF error if the matrix isn't square.
So in your example you would enter into B4: =10-DIAGONAL(B4,$B$2:$K$11) and copy this throughout the lower triangle.
You can even transpose a complete matrix ... in your screen shot, move to cell B13, enter =DIAGONAL(B2,$B$2:$K$11) and copy 9x down & right
No buttons, no need to explicitely start a Sub ... any size of n x n matrix, handles strings and numbers, ...
Here is an example with VBA. Start with an un-filled table and a button.
Then make the button run the code:
Option Explicit
Private Sub symmButton_Click()
MakeSymmetric Range("B2")
End Sub
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = CountCols(r)
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(i, j) = vals(j, i)
Next j
Next i
r.Resize(M, M).Value2 = vals
End Sub
Public Function CountCols(ByRef r As Range) As Long
If IsEmpty(r) Then
CountCols = 0
ElseIf IsEmpty(r.Offset(0, 1)) Then
CountCols = 1
Else
CountCols = r.Worksheet.Range(r, r.End(xlToRight)).Columns.Count
End If
End Function
and finally observe the results
Similar to Sean's solution, I would also use formulas. In order to get the transposed value, use this formula:
=INDEX($B$2:$G$7,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
If you want to do a more complex operation (e.g. =10-[transposedValue]), I'd recommend you use a named range: Insert a new name, e.g. TransposedValuein the Name Manager. Instead of a cell link, provide the above formula. Now you can literally write the following formula in your matrix:
=10-TransposedValue
I have this way. As you said copy paste transpose work on rectangular range. And your problem is that you have a triangular range.
You will love this....
1). Select the square range containing your upper triangular matrix and Copy.
2). Select a cell in an empty place and do the following two steps
a.) Paste Special - Values
b.) Paste Special - Values - Transpose - Skip Blanks
And you have got your symmetric matrix :-)
Anil.
Mixing together Ja72's fill code with SeanC c's Excel function code, I think I can make a generic matrix template that is properly prefilled with the dynamic Excel formula. So dynamic, and can be reused without any copy and paste.
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = 300
' Was CountCols(r), but I just limited to 300 columns for now
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(j, i) = "=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))"
Next j
'Make diagonal down the middle show ---
vals(j, i) = "---"
Next i
vals(1, 1) = "---"
r.Resize(M, M).Value2 = vals
End Sub
Sub FillSymmetric()
MakeSymmetric Range("B2")
End Sub
I don't really know any VB though, so I haven't quite figured out how to fill the header yet. I don't know Stackoverflow yet either, but I will try to add a picture.
Original List to Matrixize
Dynamically transposing values typed in SouthWest half to NorthEast half
Short answer: INDIRECT(ADDRESS(COLUMN(D2), ROW(D2)))
Explnation: you may remember we use coordinates with numbers to represent a location in Cartesian Coordinates System. So, it's easy to get a diagonal symmetric value e.g. just change (2, 3) to (3, 2).
But in Excel, we need a wordaround if we want to do so. Because, address is marked by a combination of a letter and a digit, say B2. You can't just change B2 to 2B.
Luckily, we can still use numbers to represent a cell by leveraging the power of COW() and COLUMN().
In the image below, C2 and B3 are symmetrical. This shows how to put the value of C2 to B3.
Making the formula from C.W. more generic (similar to Peter Albert), this will help when your matrix is not starting at A1 but e.g. in C10:
=INDIRECT(ADDRESS(COLUMN(C11)-COLUMN($C$10)+1,ROW(C11)-ROW($C$10)+1))
So, subtract the origin row/column and add 1.
I'm working with a dynamic array in Excel VBA. The number of columns (m) is fixed, however, I do not know how many rows (n) will be required.
The help documents state that ReDim Preserve myArray(n, m) allows me to make m larger, but not n. However, I need to increase the number of rows (n) while preserving my data, not columns (m)!
For example, I may have a (5,20) array that I would like to expand to (10,20) while preserving my data.
It seems that if there were some way to transpose my array, do a ReDim Preserve to expand the number of "columns", then re-transpose my array, I could accomplish what I want.
Is this the correct way to do this? If so, how can I do that?
Is there a better way to accomplish what I want?
One way to do what you want is to use a 1-D array that contains 1-D arrays instead of a 2-D array. Then you can ReDim Preserve the outer array all you want. If you're returning the outer array from a function, Excel will do the right thing and coerce it to a 2-D array.
For example, the function below will return a 3x2 array to the cells it's called from:
Public Function nested()
Dim outer
outer = Array(Array(1, 2), Array(3, 4))
ReDim Preserve outer(1 To 3)
outer(3) = Array(5, 6)
nested = outer
End Function
My answer to these questions might also be useful to you: Pass multidimensional array into Excel UDF in VBA and VBA pasting 3 dimensional array into sheet
Of course, if you're not returning this from a UDF, you'll have to coerce it yourself. An easy way to do that without writing looping code is to do this:
Dim coerced
coerced = Application.Index(outer, 0, 0)
This is just calling Excel's built-in INDEX function, and the zeros mean that you want back all of your rows and all of your columns. Excel will coerce your 1-D array of 1-D arrays to a 2-D array automatically. (Caveat: there are some size limitations, but they are much bigger than 10x20.)
One way how you could sove it is indeed by a double transpose with a change on the number of columns in between. This will however only work for two-dimensional arrays. It is done as follows:
' Adding one row is done by a double transposing and adding a column in between.
' (Excel VBA does not allow to change the size of the non-last dimension of a
' multidimensional array.)
myArray = Application.Transpose(myArray)
ReDim Preserve myArray(1 To m, 1 To n + 1)
myArray= Application.Transpose(myArray)
Of course m and n can be deduced as follows:
m = UBound(myArray, 1)
n = UBound(myArray, 2)
So you use the built-in transpose functionality of Excel itself. As mentioned in the code comments, this will not work for higher order matrices.
If you are developer - what is the difference between rows and columns?
Using array(N, 2) (if you have 2 columns) is the same as array(2, N) - for which you can
ReDim Preserve arr(1 to 2, 1 to N+1).
And the difference for you (as developer) will be to put the variable from the cycle in second place, instead of the first one:
N = ubound(arr)
FOR i=1 to N
GetColumn1Value = arr(1, i)
GetColumn2Value = arr(2, i)
NEXT i
Or you want this:
N = ubound(arr)
FOR i=1 to N
GetColumn1Value = arr(i, 1)
GetColumn2Value = arr(i, 2)
NEXT i
What is the difference?
Solved my own question; here's how I got around my problem. I created a temporary array, copied the contents of myArray to the temporary Array, resized myArray, then copied the contents back from the temp array to myArray.
tempArray = myArray
ReDim myArray(1 To (UBound(myArray()) * 2), 1 To m)
For i = 1 To n
For j = 1 To m
myArray(i, j) = tempArray(i, j)
Next j
Next i
If anyone can suggest a more efficient way to do this, I'd love to hear it.
The word 'transpose' immediately leaps to mind. You could simply enter data into the 2D array by flipping the columns and rows (i.e. transpose), effectively allowing you to make n (now the number of columns, but storing row values) larger when you require.
To reference the values, say in a double loop, swap the indices around. E.g. rather go from i = 1 to n and j = 1 to m where you reference value(i, j) , use i = 1 to m and j = 1 to n.
No way to determine the number of elements in the first dimension? Bummer. For a two-dimensional array with a fixed second dimension, you might want to consider making it an array of Types ("structs" in other languages) instead. That will allow you to use Redim Preserve, and still leaves you with a reasonable way to add and access values, though you'll now be accessing the second dimension as named members of the Type rather than is index values.
coercing or Slicing doesnt seem to work with Index( or Match(Index( when i want to filter array (w/o loops) based on multiple criteria, when the size of data spans greater than 2^16 rows (~ 92000 rows).
Run-Time error '13':
Type Mismatch
Transpose doesnt work with large recordsets and so also double Transpose does not work. isn't there anyway to filter an array and grab data without resorting to multiple loops?
I am thinking of trying the dictionary way or ADO with Excel.
A Caution on Redim Preserve
The urge to use ReDim Preserve here is likely misguided. Per Ken Getz and Mike Gilbert in the VBA Developer's Handbook (2006):
Using ReDim Preserve does preserve the contents of your array as it's
being resized, but it's not a fast operation... VBA must grab a chunk
of memory for the new array and then... copy over all the items in
your original array. Finally, it releases the memory used by the
original array. You'd do best to avoid ReDim Preserve if at all
possible.
Matthew Curland, a Microsoft VB developer, similarly noted in Advanced Visual Basic 6: Power Techniques for Everyday Programs (2000):
Suppose you anticipate needing 100 items up front, but... you
suddenly need space for number 101. The first reaction is a call to
ReDim Preserve to simply make the array larger. However, this call
gets more and more painful from a performance standpoint as the system
grows. You request more and more memory and possibly touch all the
memory you've previously filled. Even if you ReDim Preserve in chunks
instead of one element at a time, you'll find that the ReDim call is
the slowest part of the system.
In other words, ReDim Preserve is not as magical as it first appears. If you add one at a time, you'll see performance problems.
Now, copying an array by looping is slower yet. According to Curland, "VB's ReDim statement maps to the SafeArrayCreate[Ex] API, ReDim Preserve maps to SafeArrayRedim, and Erase maps to SafeArrayDestroy." Those APIs are much faster than loops. However, if you have to transpose the array to get there, it probably isn't worth it.
The direct way
For copying over by loop, the following sub will work. For limited use, it should be faster than transposing.
Sub RedimPreserveRows(source As Variant, newRowBound As Long)
'For 2d arrays, this copies the old data to a new array with a new Ubound for the first dimension (rows)
Dim rowBound As Long: rowBound = UBound(source)
Dim columnBound As Long: columnBound = UBound(source, 2)
Dim fillRowBound As Long: fillRowBound = IIf(newRowBound > rowBound, rowBound, newRowBound)
Dim returnArray()
ReDim returnArray(newRowBound, columnBound)
For i = 0 To fillRowBound
For j = 0 To columnBound
returnArray(i, j) = source(i, j)
Next
Next
source = returnArray
End Sub
For more: A question on alternatives to Redim Preserve was recently asked here, and I just reviewed some other options for resizing arrays in an answer here.
An array with 2 dimensions, where the number of columns are fixed and the number of rows are dynamic, can be created like this:
Sub test2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long
Dim I As Long, J As Long, x As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String
NumberOfCol = 3
J = 1
Debug.Print "Run " & Now()
Debug.Print "Sheet content"
Debug.Print "Row col1 col2 col3"
For I = 1 To 10
tmpValue = Cells(I, 1).Value
tmpValue2 = Cells(I, 2).Value
tmpValue3 = Cells(I, 3).Value
Debug.Print I & " = " & tmpValue & " " & tmpValue2 & " " & tmpValue3
If Len(tmpValue) > 0 Then
ReDim Preserve Arr2D(NumberOfCol, 1 To J)
Arr2D(1, J) = tmpValue
Arr2D(2, J) = tmpValue2
Arr2D(3, J) = tmpValue3
J = J + 1
End If
Next
'check array values
Debug.Print vbLf; "arr2d content"
Debug.Print "Row col1 col2 col3"
For x = LBound(Arr2D, 2) To UBound(Arr2D, 2)
Debug.Print x & " = " & Arr2D(1, x) & " " & Arr2D(2, x) & " " & Arr2D(3, x)
Next
Debug.Print "========================="
End Sub
TempValue read from cells A1:A10, if there is a value in cell Ax, it redim the array with +1, and add Tempvalue to array col1, add contents in Bx to array col2 and contents in Cx to array col3. If length of Ax-value is 0, it does not add anything to the array.
Debug.print show results in the "immediate window" in the VB editor.
Without the testing lines, and adding a dynamic data-range the code can be:
Sub my2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long, NumberOfRow As Long
Dim FirstCol As Long, FirstRow As Long, LastCol As Long, LastRow As Long
Dim I As Long, J As Long, X As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String
'if cells with values start in A1
With ActiveSheet.UsedRange
NumberOfCol = .Columns.Count
NumberOfRow = .Rows.Count
End With
'if cells with values starts elsewhere
With ActiveSheet.UsedRange
FirstCol = .Column
FirstRow = .Row
LastCol = .Column + .Columns.Count - 1
LastRow = .Row + .Rows.Count - 1
End With
J = 1
For I = 1 To NumberOfRow 'or For I = FirstRow to LastRow
tmpValue = Cells(I, 1).Value 'or tmpValue = Cells(I, FirstCol).Value
If Len(tmpValue) > 0 Then
ReDim Preserve Arr2D(NumberOfCol, 1 To J)
For X = 1 To NumberOfCol 'or For X = FirstCol to LastCol
Arr2D(X, J) = Cells(I, X).Value
Next X
J = J + 1
End If
Next I
End Sub