117 lines
4.1 KiB
Plaintext
117 lines
4.1 KiB
Plaintext
Sub BuildWeatherSummaries()
|
||
Dim oDoc As Object, oSheets As Object, oSheet As Object, oSummary As Object, oRefSheet As Object
|
||
Dim sheetIndex As Long, col As Long, outCol As Long, row As Long
|
||
Dim category As String, header As String, headerLow As String
|
||
Dim categories() As String
|
||
Dim startRow As Long, endRow As Long, headerRow As Long
|
||
Dim headerCell As Object
|
||
Dim outRow As Long
|
||
|
||
categories = Array("Temp", "Wind", "Rel Humidity", "Avg Total Liquid Precipitation", "Rainy Days")
|
||
|
||
headerRow = 23
|
||
startRow = 26
|
||
endRow = 37
|
||
|
||
oDoc = ThisComponent
|
||
oSheets = oDoc.Sheets
|
||
|
||
' Get REF sheet
|
||
If Not SheetExists("REF") Then
|
||
MsgBox "Reference sheet 'REF' not found! Cannot pull month abbreviations."
|
||
Exit Sub
|
||
End If
|
||
oRefSheet = oSheets.getByName("REF")
|
||
|
||
' Create or clear the Summary sheet
|
||
If Not SheetExists("Summary") Then
|
||
oSummary = oSheets.createByName("Summary", oSheets.Count)
|
||
oSheets.insertByName("Summary", oSummary)
|
||
End If
|
||
oSummary = oSheets.getByName("Summary")
|
||
oSummary.clearContents(1023) ' clear all
|
||
|
||
outRow = 0
|
||
|
||
Dim catIndex As Long
|
||
For catIndex = LBound(categories) To UBound(categories)
|
||
category = categories(catIndex)
|
||
|
||
' Write category title
|
||
oSummary.getCellByPosition(0, outRow).String = category & " Data Summary"
|
||
outRow = outRow + 1
|
||
|
||
' Write month header
|
||
oSummary.getCellByPosition(0, outRow).String = "Month"
|
||
|
||
' Fill months (Jan–Dec) from REF sheet, column A, rows 0 to 11 (adjust if needed)
|
||
For row = 0 To 11
|
||
On Error Resume Next
|
||
oSummary.getCellByPosition(0, outRow + row + 1).String = oRefSheet.getCellByPosition(0, row).String
|
||
On Error GoTo 0
|
||
Next row
|
||
|
||
outCol = 1
|
||
|
||
' Scan all sheets for matching name
|
||
For sheetIndex = 0 To oSheets.Count - 1
|
||
oSheet = oSheets.getByIndex(sheetIndex)
|
||
If InStr(LCase(oSheet.Name), "monthly") > 0 Then
|
||
col = 0
|
||
Do While col < 100 ' limit to 100 columns max to avoid infinite loop
|
||
headerCell = oSheet.getCellByPosition(col, headerRow - 1)
|
||
header = Trim(headerCell.String)
|
||
If header = "" Then Exit Do
|
||
|
||
headerLow = LCase(header)
|
||
|
||
If category = "Temp" Then
|
||
If InStr(headerLow, "avg") > 0 And InStr(headerLow, "temp") > 0 Then
|
||
Call CopyColumnData(oSheet, col, oSummary, outCol, outRow, startRow, endRow)
|
||
outCol = outCol + 1
|
||
End If
|
||
Else
|
||
If InStr(headerLow, LCase(category)) > 0 Then
|
||
Call CopyColumnData(oSheet, col, oSummary, outCol, outRow, startRow, endRow)
|
||
outCol = outCol + 1
|
||
End If
|
||
End If
|
||
|
||
col = col + 1
|
||
Loop
|
||
End If
|
||
Next sheetIndex
|
||
|
||
outRow = outRow + (endRow - startRow + 2) + 1 ' Skip past table with some space
|
||
Next catIndex
|
||
|
||
MsgBox "Weather summaries built successfully."
|
||
End Sub
|
||
|
||
|
||
Function SheetExists(sheetName As String) As Boolean
|
||
Dim oDoc As Object, oSheets As Object
|
||
oDoc = ThisComponent
|
||
oSheets = oDoc.Sheets
|
||
SheetExists = False
|
||
Dim i As Integer
|
||
For i = 0 To oSheets.Count - 1
|
||
If oSheets.getByIndex(i).Name = sheetName Then
|
||
SheetExists = True
|
||
Exit Function
|
||
End If
|
||
Next i
|
||
End Function
|
||
|
||
Sub CopyColumnData(oSheet As Object, col As Long, oSummary As Object, outCol As Long, outRow As Long, startRow As Long, endRow As Long)
|
||
Dim row As Long, dataCell As Object, headerCell As Object, header As String
|
||
|
||
headerCell = oSheet.getCellByPosition(col, 23 - 1)
|
||
header = headerCell.String
|
||
oSummary.getCellByPosition(outCol, outRow).String = oSheet.Name & " " & header
|
||
|
||
For row = startRow To endRow
|
||
dataCell = oSheet.getCellByPosition(col, row - 1)
|
||
oSummary.getCellByPosition(outCol, outRow + (row - startRow) + 1).Value = dataCell.Value
|
||
Next row
|
||
End Sub |