Okay, let’s solve this task.
If you combine what ChatGPT was able to tell, then what you described and the loop operator, you get something like this:
Sub recalcAllBirthdates1
Dim oSheet As Variant
Dim oInitCell As Variant, oData As Variant
Dim nLastRow As Long, i As Long
Dim oCell2 As Object
Dim oCell3 As Object
Dim oCell4 As Object
Dim oCell5 As Object
GlobalScope.BasicLibraries.LoadLibrary("Tools")
oSheet = ThisComponent.getSheets().getByName("Sheet1")
nLastRow = getLastUsedRow(oSheet)
oSheet.getCellRangeByPosition(2,22,5,nLastRow).clearContents(7)
oInitCell = oSheet.getCellRangeByName("E14")
oCell2 = oSheet.getCellRangeByName("D18")
oCell3 = oSheet.getCellRangeByName("D19")
oCell4 = oSheet.getCellRangeByName("D20")
oCell5 = oSheet.getCellRangeByName("D21")
For i = 22 To nLastRow
oInitCell.setValue(oSheet.getCellByPosition(0,i).getValue)
Wait 200
oSheet.getCellByPosition(2,i).setValue(oCell2.getValue())
oSheet.getCellByPosition(3,i).setValue(oCell3.getValue())
oSheet.getCellByPosition(4,i).setValue(oCell4.getValue())
oSheet.getCellByPosition(5,i).setValue(oCell5.getValue())
Next i
End Sub
The macro uses the getLastUsedRow() function from the Tools standard library to determine how many rows to process. In separate variables oCell2-oCell5 (as recommended by ChatGPT), it remembers the cells from which it will be necessary to take values for copying. The oInitCell cell will contain dates from the first column of the table.
This is exactly what is done in the loop - the i
variable receives the number of the next row, the date from the first column of the next row is written to the oInitCell cell oSheet.getCellByPosition(0,i).getValue()
, a pause is made for 1/5 second (as you asked), values from oCell2-oCell5 are transferred to the cells of the row i
.
This will work. But this is a bad decision. It’s very slow! Since the macro has to process (for your sample table) 16802 rows and after each row it pauses for 200 milliseconds, it would take 16802 * 0.2 = 3360 seconds = 56 minutes for all calculations. In fact, even longer. Because the operation of reading from a cell and writing to a cell also takes time. Honestly, forty years ago, the first computers would have printed this table much faster.
This macro can be improved. First, instead of “Wait 200” you can do “ThisComponent.calculate()” - then the wait will last exactly as long as it takes to recalculate all the formulas, which is a little faster than 1/5 of a second.
Secondly, if you place the cells with the results of the calculations not vertically, as is done in your table layout, but horizontally, then you can transfer all four cells in one read-write operation, that is, approximately four times faster. To do this, enter, for example, in cell I19 the formula =TRANSPOSE(ROUND(B18:B21;2))
and press Ctrl+Shift+Enter. These are the same values as in cells D18:D21, but arranged horizontally. Now the macro code can become like this:
Sub recalcAllBirthdates2
Dim oSheet As Variant
Dim oInitCell As Variant, oResult As Variant, oData As Variant
Dim nLastRow As Long, i As Long
GlobalScope.BasicLibraries.LoadLibrary("Tools")
oSheet = ThisComponent.getSheets().getByName("Sheet2")
nLastRow = getLastUsedRow(oSheet)
oInitCell = oSheet.getCellRangeByName("E14")
oResult = oSheet.getCellRangeByName("I19:L19")
For i = 22 To nLastRow
oInitCell.setValue(oSheet.getCellByPosition(0,i).getValue)
ThisComponent.calculate()
oSheet.getCellRangeByPosition(2,i,5,i).setDataArray(oResult.getDataArray())
Next i
End Sub
The code has become shorter and it will run faster - you can check.
But this is also not an ideal solution. Its main drawback is the constant interaction between the macro and the table, switching back and forth. This can be improved by moving all the calculations into a macro. In fact, you only need to calculate four values, store them in an array, and when the array has been processed completely, write the result to a table in one operation. This code will do exactly that:
Sub recalcAllBirthdates3
Dim oSheet As Variant, oRange As Variant, aData As Variant
Dim nLastRow As Long, i As Long
Dim sourceDate As Double, dateDiff As Double
GlobalScope.BasicLibraries.LoadLibrary("Tools")
oSheet = ThisComponent.getSheets().getByName("Sheet1")
nLastRow = getLastUsedRow(oSheet)
sourceDate = oSheet.getCellRangeByName("B14").getValue()
oRange = oSheet.getCellRangeByPosition(0,22,5,nLastRow)
aData = oRange.getDataArray()
For i = LBound(aData) To UBound(aData)
dateDiff = aData(i)(0) - sourceDate
aData(i)(2) = ABS(COS(PI()*dateDiff/23))*100
aData(i)(3) = ABS(COS(PI()*dateDiff/28))*100
aData(i)(4) = ABS(COS(PI()*dateDiff/33))*100
aData(i)(5) = (aData(i)(2)+aData(i)(3)+aData(i)(4))/3
aData(i)(2) = Int(aData(i)(2)*100+0.5)/100
aData(i)(3) = Int(aData(i)(3)*100+0.5)/100
aData(i)(4) = Int(aData(i)(4)*100+0.5)/100
aData(i)(5) = Int(aData(i)(5)*100+0.5)/100
Next i
oRange.setDataArray(aData)
End Sub
Yes, these formulas do not use TODAY(). Yes, the last four formulas are only needed to round the result to two decimal places. But it works faster than the previous version.
Can this macro be improved? Yes, you can. Let’s just ask ourselves “Is a cycle necessary here?” and the answer is “No, it is not needed”:
Sub recalcAllBirthdates4
Dim oSheet As Variant
Dim oRange As Variant
Dim nLastRow As Long
GlobalScope.BasicLibraries.LoadLibrary("Tools")
oSheet = ThisComponent.getSheets().getByName("Sheet1")
nLastRow = getLastUsedRow(oSheet)
oSheet.getCellRangeByName("C23").setFormula("=ABS(COS(PI()*($A23-$B$14)/23))*100")
oSheet.getCellRangeByName("D23").setFormula("=ABS(COS(PI()*($A23-$B$14)/28))*100")
oSheet.getCellRangeByName("E23").setFormula("=ABS(COS(PI()*($A23-$B$14)/33))*100")
oSheet.getCellRangeByName("F23").setFormula("=AVERAGE(C23:E23)")
oRange = oSheet.getCellRangeByPosition(2,22,5,nLastRow)
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1)
oRange.setDataArray(oRange.getDataArray())
oRange.NumberFormat = 2
End Sub