Routine To Add Autosums in 3 different cells based on the value in another cell

[TkdKidSnake]

Hi all,

I am trying to add numerous autosum's to the worksheet I am working on using VBA and to say I am struggling is an understatement. Below is a link to a picture that show what I am trying to do.

https://photos.app.goo.gl/kt4kp8uULuM4hWvFA

I need a routine to check the whole worksheet as it varies in length and only when "Total Lines" is the value in column P does it need to enter the autosum's in columns M, N & O in the adjacents cells on the same row.

The issue I have is that directly above where the autosums need to be entered there is a blank row, also above the data to be autosummed there is another blank row to give the autosum the required cut off.


If anyone can help with this is would be greatly appreciated.

Thanks in advance

 

[Peter_SSs]

Bit of a guess without knowing what else is on the sheet, but give this a try in a copy of your workbook.
I have assumed that the "Totals" texts in column L are not the results of formulas

Sub Add_Totals()
  Dim cell As Range
  
  For Each cell In Range("L3", Range("L" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlTextValues)
    cell.Offset(, 1).Resize(, 3).FormulaR1C1 = "=SUM(R" & cell.Offset(-2).CurrentRegion.Row & "C:R[-2]C)"
  Next cell
End Sub

 

[TkdKidSnake]

Many thanks for you help, I have tried this however it appears to be totalling all sections together whereas it should only total between the blanks, apologies if I didn't explain properly

Bit of a guess without knowing what else is on the sheet, but give this a try in a copy of your workbook.
I have assumed that the "Totals" texts in column L are not the results of formulas

Sub Add_Totals()
  Dim cell As Range
  
  For Each cell In Range("L3", Range("L" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlTextValues)
    cell.Offset(, 1).Resize(, 3).FormulaR1C1 = "=SUM(R" & cell.Offset(-2).CurrentRegion.Row & "C:R[-2]C)"
  Next cell
End Sub

 

[Peter_SSs]

Many thanks for you help, I have tried this however it appears to be totalling all sections together whereas it should only total between the blanks, apologies if I didn't explain properly

Although the formulas are apparently wrong, is the code putting formulas in the correct cells?

 

[TkdKidSnake]

Yes they are in the correct cells, which is considerably further than I managed to get

Although the formulas are apparently wrong, is the code putting formulas in the correct cells?

 

[Peter_SSs]

Try this one then

Sub Add_Totals_v2()
  Dim cell As Range
  Dim fr As Long
  
  For Each cell In Range("L3", Range("L" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlTextValues)
    fr = 4
    On Error Resume Next
    fr = Range("O1", Range("O" & cell.Row)).Find(What:="OTIF", SearchDirection:=xlPrevious).Row + 2
    On Error GoTo 0
    cell.Offset(, 1).Resize(, 3).FormulaR1C1 = "=SUM(R" & fr & "C:R[-2]C)"
  Next cell
End Sub

 

[TkdKidSnake]

Excellent that works an absolute treat, thank you for this it's greatly appreciated.

Try this one then

Sub Add_Totals_v2()
  Dim cell As Range
  Dim fr As Long
  
  For Each cell In Range("L3", Range("L" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlTextValues)
    fr = 4
    On Error Resume Next
    fr = Range("O1", Range("O" & cell.Row)).Find(What:="OTIF", SearchDirection:=xlPrevious).Row + 2
    On Error GoTo 0
    cell.Offset(, 1).Resize(, 3).FormulaR1C1 = "=SUM(R" & fr & "C:R[-2]C)"
  Next cell
End Sub

 

[Peter_SSs]

Excellent that works an absolute treat, thank you for this it's greatly appreciated.

Glad to help.