Option Explicit
Sub johnmplBigStack()
Rem 1) 'Worksheets info, Input Data
Dim WB As Workbook: Set WB = ThisWorkbook ' 'Variable gets all methods, Properties etc. of Workbooks object, which intellisense will offer us after we use .Dot
Dim wsData As Worksheet: Set wsData = WB.Worksheets("Hoja1SmallTestie")
Dim srT As Long, srS As Long, sr1 As Long, srNxt As Long 'As Long 'Variable for Range start row, search start row , first start row and found next start row of Ranges. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )
Let sr1 = wsData.Cells.Find(What:="*", After:=wsData.Cells(1, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'Get next Row with entry anywhere for Worksheet Hoja1. Method: You start at first cell then go fowards , searching for anything ( = * ) by rows, then get the row number. Method that finds next row in sheet rather than next row for particular cell. Better to use that here as we are not sure which columns are full
Let srT = sr1 ' initially start row is first start row
' Dim lc As Long 'Variable for last column, assuming last column is the same for all Ranges
Dim clsr As Long 'Any column in first row of a range
' Let lc = wsData.Cells(sr1 + 1, Columns.Count).End(xlToLeft).Column 'The Range Object ( cell ) that is the last cell in the row of interest has the property .End ( argument Xl to left ) appleid to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking back" the XL spreadsheet from the last cell. Then the .Column Property is applied to return a long number equal to the column number of that cell
Rem 2) 'Make Stack Array ( 1 D array of " D Array )
Dim arrIn() As Variant ' 'Variable for Dynamic Input Array. Will become full input data for one table Will be got with .Value Property which for a Range greater than 1 cell returns Elements of a collection which are defined initially as variant by VBA. So that is why we have Array() = Variant
Dim StackChops() As Variant 'StackChops is an Array of Arrays. The number of Arrays in it is equal to the number of 2 D Ranges. It must continuously be resizes, so must be Dynamic. Must be Variant type as that in the only Type that wil Take a data Field
Dim rngNo As Long 'Number of Range/ Count of Ranges
'Let lDB = wsData.Cells(Rows.Count, 10).End(xlUp).Row 'The Range Object ( cell ) that is the last cell in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell
Do While srNxt <> sr1 ' we continue until the srNxt goes past end of sheet then starts at beginning and finds initial sr1 ( as it does by the methood es use to get the next row
Let rngNo = rngNo + 1 'Increase Range count at start of each considersation of Next Range
Let clsr = wsData.Cells.Find(What:="*", After:=wsData.Cells(srT, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Column
Let arrIn() = wsData.Cells(srT, clsr).CurrentRegion.Value2 'CurrentRegion Property applied to a Range object returns a new range which is a "box" encompasing all connected cells to that Range Object. The Property .Value2 applied to a Range of more than 1 cell returns a colllection ( Array ) of the undelying values all the cells in that range. VBA allows a "one liner" to then assign these value to a dynamic Array. The Elements of the collection are defined initially as variant by VBA. So that is why we had Array() = Variant.
ReDim Preserve StackChops(1 To rngNo) 'Whils preserving Array Contents, increase size to make an additional Element for next range ( By first rang this ReDims to existing size!, but WTF)
Let StackChops(rngNo) = arrIn() 'Next Element in Array is current Input Table
Let srS = srT + UBound(StackChops(rngNo), 1) 'This gives next row after current table as start for nesxt start row search.
Let srNxt = wsData.Cells.Find(What:="*", After:=wsData.Cells(srS, 1), Lookat:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 'Get next Row with entry anywhere for Worksheet Hoja1.
Let srT = srNxt 'Set range start row to next found range start
Loop 'While srNxt <> sr1
Rem 3) ' Paste out stacks to tempory Sheet: if Shheet does not exist first make it
If Not Evaluate("=ISREF('Temp'!A1)") Then 'Check to see if the sheet is there by seeing if the reference to cell A1 in that sheet doesn't exist. If it is true that it does not exist, then
WB.Worksheets.Add(After:=WB.Worksheets("Hoja1SmallTestie")).Name = "Temp" 'Add in this Workbook given name Temp
Else
ThisWorkbook.Worksheets("Temp").Move After:=ThisWorkbook.Worksheets("Hoja1SmallTestie") 'Otherwise If the sheet is there it could be anywhere so we put it after "Hoja1SmallTestie"
Worksheets("Temp").Activate
Worksheets("Temp").Cells.Clear 'Empty any previous Data. Important to use Clear, not ClearContents to remove all formatting also or else the Usedrange Property will not work below ##
End If
Dim j As Long, y As Long: Let y = 1 'Loop Bound variable Count for StackArray indicies, next rung ( row for rangge Element Top left Corner )
For j = 1 To UBound(StackChops()) 'Going through each element in stacked " D Arrays
Worksheets("Temp").Range("A" & y & "").Resize(UBound(StackChops(j), 1), UBound(StackChops(j), 2)).Value = StackChops(j) 'A nice "One" liner - Resize selected cell to size of output Array and then the allowed VBA assignment of a collection of values to a Spreadsheet range
Let y = y + UBound(StackChops(j), 1) 'Increase rung to next free rung
Next j
Rem 4) ' Produce Final Output Array
Dim arrOut() As Variant ' Dynamic Array needed as will be assigned to Tempory Sheet Usedrange, getting the Size thereof. The "One Liner Capture" method we use will return a data Field of type Variant so we must Dimension appropriately here
Let arrOut() = Worksheets("Temp").UsedRange.Value ' ##Used range property of a Worksheet returns a Range Object that is effectivelly the "box" extending to cover all cells ever used ( changed ) in a Worksheet
Rem 5) 'Demonstrate Output Array
'5a) Stack Array
Dim strMsgBox As String, arrLine() As Variant 'String for a Message box, 1 D Array for each row
For j = 1 To UBound(StackChops()) 'Going through each element in stacked " D Arrays
For y = 1 To UBound(StackChops(j), 1) 'going through each row in Stack 2 D Array Element
Let arrLine() = Application.Index(StackChops(j), y, 0) 'Slice Array out Row to give a 1 D Array Array of that row https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/
Let strMsgBox = strMsgBox + Join(arrLine(), ",") & vbLf 'Build String from joing 1 D Array elemnts with a "," and a carriage return
Next y
MsgBox Prompt:="Stack Array element " & j & " looks like this " & vbLf & strMsgBox & ""
Let strMsgBox = "" 'Empty string for use in next Stach Element
Next j
Let strMsgBox = "" 'Empty string for use in next demo
'5b) Output Array
For y = 1 To UBound(arrOut(), 1) 'going through each row in Outpt Array
Let arrLine() = Application.Index(arrOut(), y, 0)
Let strMsgBox = strMsgBox + Join(arrLine(), ",") & vbLf
Next y
MsgBox Prompt:="Output Array looks like this " & vbLf & strMsgBox & ""
End Sub
Alan
