Column Extraction
Given a range of data it shows how to extract a column from this range. On its own you may not have much use for this macro but it is nonetheless a simple and decent example.
Function ColExtract( Matrix As Variant, Column As Integer ) Dim numRows As Integer numRows = UBound( Matrix ) - LBound( Matrix ) + 1 Dim result( 1 to numRows, 1 to 1 ) As Variant For row = 1 to numRows a = row + LBound(Matrix, 1) - 1 b = Column + LBound( Matrix, 2 ) - 1 result( row, 1 ) = Matrix( a, b ) Next row ColExtract = result() End Function
Column Combination
Given two columns of data produces a concatenation of that data. This was done since the standard CONCATENATE command didn't seem to accept a series of data. It was meant to be used in conjunction with SUMIF, but due to Issue #10798 it doesn't work. Nonetheless this is another simple example.
' Combines the contents of two colums (as strings) putting an infix between the ' combination Function ColCombine( ColA As Variant, ColB As Variant, Infix As String ) Dim numRows As Integer numRows = UBound( ColA ) - LBound( ColA ) + 1 Dim result( 1 to numRows, 1 to 1 ) As Variant For row = 0 to (numRows-1) result( row + 1, 1 ) = ColA( row + LBound( ColA ), 1 ) + Infix + ColB( row + LBound( ColB ), 1 ) Next row ColCombine = result() End Function
Row Filtering
Given a range of data this filters out rows that don't match your desired criteria. Your standard Calc filtering is much more powerful than this, but this technique can be adapted to do more advanced filtering that you might need (be careful with large data sets though -- basic can't handle so many rows before it gives up)
' Filters a series of rows, removing all those rows that do not match ' the specification: The data is matched in Column against VAlue, if ' it doesn't match, then it is filtered out. Column is 1-based. Function RowFilter( Matrix as Variant, Column As Integer, Value As String ) Dim numCols, index, numRows As Integer numCols = UBound( Matrix, 2 ) - LBound( Matrix, 2 ) + 1 numRows = UBound( Matrix, 1 ) - LBound( Matrix, 1 ) + 1 ' produce a maximum size array Dim result( 1 to numRows, 1 to numCols ) As Variant index = 0 For row = LBound( Matrix ) to UBound( Matrix ) matrixValue = Matrix( row, Column + LBound( Matrix, 2 ) - 1 ) if matrixValue = Value Then index = index + 1 CopyRow( result(), index, Matrix(), row ) end if Next row ' do we have any data? if index = 0 then RowFilter = Array() exit function end if ' copy to a smaller array Dim reduce( 1 to index, 1 to numCols ) As Variant For row = 1 to index CopyRow( reduce(), row, result(), row ) Next row RowFilter = reduce() End Function ' copies a row in a matrix Sub CopyRow( mTo As Variant, rowTo as Integer, mFrom As Variant, rowFrom As Integer ) lFrom = LBound( mFrom, 2 ) lTo = LBound( mTo, 2 ) For i = lFrom to UBound( mFrom, 2 ) mTo( rowTo, i - lFrom + lTo ) = mFrom( rowFrom, i ) Next i End Sub
