Macro to sum between headers

[simpmark]

Hi,

I need to find a Macro in order to sum the forecast on each header in a result report, the workbook could maintain a lots of different sheets, where the headers is dynamic.*

In attached example you could see that the values always starts on row 10, in every sheet. I need to sum values in column H in each header. That means sum the values above "Sales", sum the values between "Sales" and "Travels", sum the values between "Travels" and "Staff" and this is how it goes..

Could somebody please help me finding a Macro for this?

[BrianMH]

FYI this is a cross post.

http://www.mrexcel.com/forum/excel-questions/791886-sum-between-headers.html

[p45cal]

FYI this is a cross post.I think BrianMH's message is more important for simpmark than my offering below although he probably doesn't realise it. simpmark, take a look at: http://www.excelguru.ca/content.php?184-A-message-to-forum-cross-posters , then you won't need to wonder why you don't get responses in the future…

The following code is in the attached version of your file:
Sub blah()
Dim xx As Range, Results(), SortedResults()
zz = Array("Sales", "Travel ", "Staff ", "Operational costs", "Total costs") 'note trailing space in Travel and Staff.
For Each sht In ThisWorkbook.Sheets
ReDim Results(1 To 2, 1 To 1)
FoundCount = 0
If Left(sht.Name, 2) = "CC" Then 'to avoid processing your hidden Totals sheet.
'sht.Activate
For Each cat In zz
Set xx = sht.Range("A6:A60").Find(what:=cat, LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=False)
If Not xx Is Nothing Then
'xx.Select
FoundCount = FoundCount + 1
ReDim Preserve Results(1 To 2, 1 To FoundCount)
Results(1, FoundCount) = cat
Results(2, FoundCount) = xx.Row
End If
Next cat
'sort results (may not be necessary if the cateories are always in the same order):
aa = Application.Index(Results, 2, 0)
ReDim SortedResults(1 To 2, 1 To UBound(Results, 2))
For i = 1 To UBound(Results, 2)
'MsgBox Application.WorksheetFunction.Small(aa, i)
x = Application.Match(Application.WorksheetFunction.Small(aa, i), aa, 0)
SortedResults(1, i) = Results(1, x)
SortedResults(2, i) = Results(2, x)
Next i
'add the formulae:
TopRowOfSum = 6
uu = ""
For i = 1 To UBound(Results, 2)
'sht.Cells(SortedResults(2, i), "H").Select
If SortedResults(1, i) = "Total costs" Then
For j = 1 To UBound(Results, 2)
If j <> i Then uu = uu & ",H" & SortedResults(2, j)
Next j
uu = Mid(uu, 2)
sht.Cells(SortedResults(2, i), "H").Formula = "=SUM(" & uu & ")"
Else
sht.Cells(SortedResults(2, i), "H").Formula = "=SUM(H" & TopRowOfSum & ":H" & SortedResults(2, i) - 1 & ")"
TopRowOfSum = SortedResults(2, i) + 1
End If
Next i
End If
Next sht
End Sub
Just run blah.
The code is a bit flaky because in your sheets you have headers Staff and Travel both of which are followed by a trailing space. If these spaces are not in all of the sheets then they won't be found by the code. So you have to make sure that what the code's looking for exactly matches the cells in column A of each sheet (I could code round it but I haven't bothered). The relevant line in the code is:
zz = Array("Sales", "Travel ", "Staff ", "Operational costs", "Total costs") 'note trailing space in Travel and Staff.
I've added a 4th sheet (CC2000 (2))at the end to show you what happens when Staff in column A doesn't have a trailing space; the formula in H23 is awry and there is no formula in H20.