Averaging a row when header columns are merged

[fjdurbin]

Row 1, Column E thru Z contain my headers. Sometimes the headers are merged across multiple columns and sometimes not. The data will be in rows 2 thru whatever.

For Example:

The column header in E1:G1 has Site 1. E2:G2 contains the data for Site 1. Thus E2=5, F2=13, G2=5. So the total for Site 1 is 23.
The column header in H1 has Site 2. H2 contains the data for Site 2. Thus H2=12. So the total for Site 2 is 12.
The column header in I1:M1 has Site 3. I2:M2 contains the data for Site 3. Thus I2=4, J2=7, K2=0, L2=15, M2=5. So the total for Site 3 is 31.
...and so on thru column Z

In column C I will need the Average for all Sites.

There will be many rows but I'm trying to figure out the logic so I'm just coding for row 2.

What I've been trying to do is determine what cells are merged and which are not. Unfortunately, as I loop thru the cells I haven't figured out how to avoid repeating cells references because of the merged cells. Here is the code and I look at the results in the Immediate Window:

Sub test7()
For x = 5 To 26
Cells(1, x).Select
If ActiveCell.MergeArea.Columns.Count = 1 Then
    Debug.Print Cells(1, x).Address
Else
If ActiveCell.MergeArea.Columns.Count > 2 Then
    Debug.Print ActiveCell.MergeArea.Address
End If
End If
Next x
Range("c" & 2).Select
End Sub

The results look like:

$E$1:$G$1
$E$1:$G$1
$E$1:$G$1
$H$1
$I$1:$L$1
$I$1:$L$1
$I$1:$L$1
$I$1:$L$1
$M$1:$P$1
$M$1:$P$1
$M$1:$P$1
$M$1:$P$1
$Q$1
$R$1
$S$1:$X$1
$S$1:$X$1
$S$1:$X$1
$S$1:$X$1
$S$1:$X$1
$S$1:$X$1
$Y$1
$Z$1

But I want the results to look like:

$E$1:$G$1
$H$1
$I$1:$L$1
$M$1:$P$1
$Q$1
$R$1
$S$1:$X$1
$Y$1
$Z$1



Any suggestions?

 

[fjdurbin]

I think I figured it out but probably not as elegantly as others could:

Sub test8()
Dim str As String
For x = 5 To 26
Cells(1, x).Select
If ActiveCell.MergeArea.Columns.Count = 1 Then
Debug.Print Cells(1, x).Address
Else
If ActiveCell.MergeArea.Columns.Count > 2 Then
If str <> ActiveCell.MergeArea.Address Then Debug.Print str
End If
str = ActiveCell.MergeArea.Address
End If
Next x
Debug.Print str
Range("c" & 2).Select
End Sub

Will produce:

$H$1
$E$1:$G$1
$I$1:$L$1
$Q$1
$R$1
$M$1:$P$1
$Y$1
$Z$1
$S$1:$X$1

Can anyone suggest improvements?

 

[MickG]

This code will provide in column "C" the average of the sums of each set of merged cells in row 1, but related to the individual rows.
I think that what you ultimately wanted !!!!!

[COLOR="Navy"]Sub[/COLOR] MG28Mar58
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, oSum [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("E1:Y1")
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.MergeArea.Address) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.MergeArea.Address, Dn.MergeArea
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
    Lst = Range("E" & Rows.Count).End(xlUp).Row
    [COLOR="Navy"]For[/COLOR] n = 1 To Lst - 1
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
            oSum = oSum + Application.Sum(.Item(K).Offset(n).Resize(, .Item(K).Count))
        [COLOR="Navy"]Next[/COLOR] K
        Range("C" & n + 1) = oSum / .Count: oSum = 0
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[fjdurbin]

WOW!!! Thank you!

If you don't, you should wear a cape!

I am very grateful for your help...JD

 

[MickG]

You're welcome