How to subset a spreadsheet by month (for any year) when column 1 contains dates

[MJClinic]

I want 12 new sheets created from my main spreadsheet. Each new sheet (e.g. Jan Feb Mar …) will contain all the rows of the main sheet filtered by month Input data is lines structured like “Datefield , Other , fields [EOL]” and I want one sheet per month based on datefield.

[JohnSUN]

Welcome! There are many solutions for this task, from the simplest (repeat 12 times filtering using the Standard filter with copying the result to a new sheet) to quite complex for a beginner (using Base with the original sheet as data source and 12 queries, the results of which are placed in separate sheets, or not very complex macro). The choice of method depends on how often you fill in or change the original table, how well you know the tools of the office suite, do you know programming …

[JohnSUN]

I promised that the macro will not be very difficult. Here it is:

Option Explicit

Sub SplitTableByMonth()
Const MAIN_SHEET_NAME = "Main Sheet"	' Change to the real name of your source sheet '
Dim oSheets As Variant,	oSourceSheet As Variant, oTargetSheet As Variant
Dim oCursor As Variant, aRangeAddress As New com.sun.star.table.CellRangeAddress
Dim aCellAddress As New com.sun.star.table.CellAddress
Dim i As Long, j As Long 
Dim oDataArray As Variant, aRes As Variant, aRows As Variant 
Dim sMonthName As String 
	oSheets = ThisComponent.getSheets()
	oSourceSheet = oSheets.getByName(MAIN_SHEET_NAME)
	oCursor = oSourceSheet.createCursor()
	oCursor.gotoEndOfUsedArea(True)
	aRangeAddress = oCursor.getRangeAddress()
	oDataArray = oCursor.getCellRangeByPosition(0, 0, 0, aRangeAddress.EndRow).getDataArray()
	aRes = Array()
	For i = 1 To UBound(oDataArray)
		sMonthName = Format(oDataArray(i)(0), "YYYY-MM")	' As 2021-10 for correct sort '
		AddToTree(sMonthName, i, aRes)	' Enumerate row numbers for each month separately '
	Next i
	For i = LBound(aRes) To UBound(aRes)
		sMonthName = Format(DateValue(aRes(i)(0)&"-01"), "YYYY-MMM")	' As 2020-Dec for sheet name /
		aRows = aRes(i)(1)
		If oSheets.hasByName(sMonthName) Then	' There is already a sheet with the same name - clear it '
			oTargetSheet = oSheets.getByName(sMonthName)
			oTargetSheet.clearContents(1023)
		Else	' There is no sheet with this name - create a new one '
			oSheets.insertNewByName(sMonthName, oSheets.getCount())
			oTargetSheet = oSheets.getByName(sMonthName)
		EndIf 
		aCellAddress = oTargetSheet.getCellByPosition(0, 0).getCellAddress()	' Address of A1 in this sheet '
Rem Copy headers
		aRangeAddress.StartRow = 0
		aRangeAddress.EndRow = aRangeAddress.StartRow
		oTargetSheet.copyRange(aCellAddress, aRangeAddress)
Rem Copy other
		For j = LBound(aRows) To UBound(aRows)
			aCellAddress.Row = j +1
			aRangeAddress.StartRow = aRows(j)
			aRangeAddress.EndRow = aRangeAddress.StartRow
			oTargetSheet.copyRange(aCellAddress, aRangeAddress)
		Next j
	Next i
End Sub

Sub AddToTree(key As Variant, value As Variant, aData As Variant)
Rem Create "tree" of row numbers - month numbers are branches, row numbers are leaves
Dim l&, r&, m&, N&, i&
    l = LBound(aData)
    r = UBound(aData) + 1
    N = r
    While (l < r)
        m = l + Int((r - l) / 2)
        If aData(m)(0) < key Then l = m + 1 Else r = m
    Wend
    If r = N Then
        ReDim Preserve aData(0 To N)
        aData(N) = Array(key, Array(value))
    ElseIf aData(r)(0) = key Then
    	AppendToArray(aData(r)(1), value)
    Else
        ReDim Preserve aData(0 To N)
        For i = N - 1 To r Step -1
            aData(i + 1) = aData(i)
        Next i
        aData(r) = Array(key, Array(value))
    End If
End Sub

Sub AppendToArray(oData As Variant, ByVal x As Variant)
Rem Just add new element x to the end of array oData
Dim iLB As Long, iUB As Long
    iLB = LBound(oData, 1)
    iUB = UBound(oData, 1) + 1
    ReDim Preserve oData(iLB To iUB)
    oData(iUB) = x
End Sub

Small demo - SplitTableBySheets.ods