You may try this code. For detail see the attached sheet.
Sub summaxrowvalue()
Dim rng1 As Range, cell1 As Range, rng2 As Range, cell2 As Range, rngc As Range
Dim lr1 As Long, lr2 As Long, lc As Integer
Dim ncol1 As Integer, ncol2 As Integer
lr1 = Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Cells(Rows.Count, 7).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Set rngc = Range(Cells(1, 1), Cells(1, lc))
Set rng2 = Range("G2:G" & lr2)
For Each cell2 In rng2
ncol1 = Application.WorksheetFunction.Match(cell2, rngc, 0)
ncol2 = Application.WorksheetFunction.Match(cell2.Offset(0, 1), rngc, 0)
If ncol1 < ncol2 Then
Set rng1 = Range(Cells(2, ncol1), Cells(lr1, ncol1))
For Each cell1 In rng1
Sum = Sum + Application.WorksheetFunction.Max(cell1, cell1.Offset(0, ncol2 - ncol1))
Next cell1
Else
Set rng1 = Range(Cells(2, ncol2), Cells(lr1, ncol2))
For Each cell1 In rng1
Sum = Sum + Application.WorksheetFunction.Max(cell1, cell1.Offset(0, ncol1 - ncol2))
Next cell1
End If
cell2.Offset(0, 2) = Sum
Sum = 0
Next cell2
End Sub
Bookmarks