Add BuildWeatherSummaries
This commit is contained in:
117
BuildWeatherSummaries
Normal file
117
BuildWeatherSummaries
Normal file
@@ -0,0 +1,117 @@
|
|||||||
|
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
|
||||||
Reference in New Issue
Block a user