Tom, Jim and other experts with VB,

Given below is the code (written by Tom) that highlights the area of
intersection of two cells (merged or single).

For example, if the merged cells B4 (formed by merging B4 to B9) and H2
(formed by merging H2 to L2) are clicked, then the higlighted area with
boundary is H4-H9; H9-L9; L9-L4; L4-H4.

As a step ahead, along with the border highlighting, is it possible to
collapse all the cells in the boundary into a single cell that shows
the SUM of the elements in it...? If yes, please help me.

In lines of the example discussed above, is it possible to show the sum
of H4-H9; H9-L9; L9-L4; L4-H4 in a single cell inside that boundary? I
tried recording macro. It was not generic. Moreover, it did not yield
the required results.

Please help.

Thanks,
Thulasiram.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count = 2 Then
OutlineSelectedAreas Target.Areas(1), Target.Areas(2)
End If
End Sub

Function OutlineSelectedAreas(ByRef Rng1 As Excel.Range, _
ByRef Rng2 As Excel.Range)
Dim Rng3 As Excel.Range
' Dim lngRow As Long
' Dim lngCol As Long
' Dim lngLastRow As Long
' Dim lngLastCol As Long
With Cells
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With


' lngRow = Application.Min(Rng1.Row, Rng2.Row)
' lngCol = Application.Min(Rng1.Column, Rng2.Column)
' lngLastRow = Application.Max(Rng1.Rows(Rng1.Rows.Count).Row, _
Rng2.Rows(Rng2.Rows.Count).Row)
' lngLastCol =
Application.Max(Rng1.Columns(Rng1.Columns.Count).C olumn, _
Rng2.Columns(Rng2.Columns.Count).Column)

' Set Rng3 = Range(Cells(lngRow, lngCol), Cells(lngLastRow,
lngLastCol))
If Rng1.Column = Rng2.Column Then
If Rng1.Row < Rng2.Row Then
Set rngTmp = Rng1
Set Rng1 = Rng2
Set Rng2 = rngTmp
End If
ElseIf Rng1.Column Rng2.Column Then
Set rngTmp = Rng1
Set Rng1 = Rng2
Set Rng2 = rngTmp
End If
Set Rng3 = Intersect(Rng1.EntireRow, Rng2.EntireColumn)
Rng1.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
Rng2.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
Rng3.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
Set Rng1 = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
End Function