Macro to Sub total varying lists of numbers

[shredda23]

Hi I am fairly new to excel and I am having trouble trying to get a sub total function to work for me. I need the subtotal to for a list of about 20 columns in one line with a varying amount of rows. So the subtotal must stop when there is a blank at the top. I can get the macro to find the totals A on the spreadsheet and then offset to beneath the columns of numbers but the sub total formulas takes in every number. I'm hoping somone can help. Here is the example:

456.00</SPAN> 8,798.00</SPAN> 45,465.00</SPAN> 789,789.00</SPAN> 45,465.00</SPAN> 789,789.00</SPAN> 45,646.00</SPAN> 7,897.00</SPAN> Totals A</SPAN> 45,646.00</SPAN> 456,465.00</SPAN> 45,646.00</SPAN> 456,465.00</SPAN> 1,231.00</SPAN> 56,456.00</SPAN> 45,646.00</SPAN> 5,465.00</SPAN> 56,456.00</SPAN> 4,546.00</SPAN> 45,646.00</SPAN> Totals B</SPAN> 456,465.00</SPAN> 1,231.00</SPAN> 56,456.00</SPAN> 45,646.00</SPAN> 5,465.00</SPAN> 56,456.00</SPAN> 4,546.00</SPAN> 45,646.00</SPAN> 48,654.00</SPAN> 7,987.00</SPAN> 546.00</SPAN> 89.00</SPAN> 456.00</SPAN> 899.00</SPAN> Totals C</SPAN> <TBODY> </TBODY><COLGROUP><COL><COL><COL></COLGROUP>	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
		</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
</SPAN>
		</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>
	</SPAN>	</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL></COLGROUP>

 

[Peter_SSs]

The data will always start in row 10 and the number of columns will always be from col f to clomun Y so 20 columns.

We may need to be more specific in searching for the "subtotal" cells in column B, but give this a try in a copy of your workbook.

Sub DoSubTotals()
  Dim oSet As Long
  Dim rng As Range
  
  Const TotalLabelsCol As String = "B"  '<- Change if required
  Const FirstDataCol As String = "F"    '<- Change if required
  Const FirstDataRow As Long = 10       '<- Change if required
  Const NumFormulaCols As Long = 20     '<- Change if required
  Const fBase As String = "=SUM(R#C:R[-1]C)"
  
  oSet = Columns(FirstDataCol).Column - Columns(TotalLabelsCol).Column
  For Each rng In Range(TotalLabelsCol & FirstDataRow, _
      Range(TotalLabelsCol & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
  rng.Select
    rng.Cells(rng.Rows.Count, 1).Offset(, oSet).Resize(1, NumFormulaCols).FormulaR1C1 _
      = Replace(fBase, "#", rng.Row, 1, 1, 1)
  Next rng
End Sub

 

[shredda23]

wow thanks a million and sorry for all the confusion. This works perfectly!!

Thanks!!!

 

[Peter_SSs]

wow thanks a million and sorry for all the confusion. This works perfectly!!

Thanks!!!

Great!

I just realised that I forgot the "rng.Select" line in my code. I had that in for myself while testing but it is not required, will slow the code and will probably make the screen flicker needlessly while the code runs. Best to remove it.