Sum Excel Ranges Diagonally

Sum: Left-to-right | Right-to-left | Top-down | Bottom-up

Got any Excel/VBA Questions? Excel Help

Diagonal Sum

Ever wanted to sum some cells in Excel, but with a twist. Sum cells diagonally top-to-bottom and vice versa, left-to-right and vice versa. This code will give Excel that ability. As with nearly all custom functions for excel, it pays to keep the ranges used as small as possible.

Function SumDiagonal(rRange As Range, LrRl As String, Optional BsrtBottom As Boolean) As Single

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'WRITTEN BY OZGRID.COM

'Sum a range cells diagonally. Summation occurs left-to-right or right-to-left _
    top-to-bottom (default) or bottom-to-top

'rRange should be as small as possible for efficieny
Dim lRows As Long, lCol As Long, lLoopR As Long, lloopC As Long
Dim sTot As Single

lRows = rRange.Rows.Count
lCol = rRange.Columns.Count
lloopC = 1
    With WorksheetFunction
    'Left to right, top to bottom
        If UCase(LrRl) = "LR" And BsrtBottom = False Then
                For lLoopR = 1 To lRows
                   sTot = .Sum(rRange(lLoopR, lloopC), sTot)
                    lloopC = lloopC + 1
                Next lLoopR
        'Right to left, top to bottom
        ElseIf UCase(LrRl) = "RL" And BsrtBottom = False Then
            lloopC = lCol
                For lLoopR = 1 To lRows
                    sTot = .Sum(rRange(lLoopR, lloopC), sTot)
                    lloopC = lloopC - 1
                    If lloopC = 0 Then GoTo Result
                Next lLoopR
         'Right to left, bottom top
        ElseIf UCase(LrRl) = "RL" And BsrtBottom = True Then
            lloopC = lCol
                For lLoopR = lRows To 1 Step -1
                    sTot = .Sum(rRange(lLoopR, lloopC), sTot)
                    lloopC = lloopC - 1
                    If lloopC = 0 Then GoTo Result
                Next lLoopR
         'Left to right, bottom top
        ElseIf UCase(LrRl) = "LR" And BsrtBottom = True Then
            lloopC = lCol
                For lLoopR = lRows To 1 Step -1
                    sTot = .Sum(rRange(lLoopR, lloopC), sTot)
                    lloopC = lloopC - 1
                    If lloopC = 0 Then GoTo Result
                Next lLoopR
        End If
    End With
Result:
SumDiagonal = sTot
End Function