Thread: A query in continuation to the nested bordering - To TOM, JIM and others....
View Single Post
  #8   Report Post  
Posted to microsoft.public.excel.programming
Thulasiram[_2_] Thulasiram[_2_] is offline
external usenet poster
  
Posts: 106
Default A query in continuation to the nested bordering - To TOM, JIM and others....
Dear Mr.Bob,

I am sure that this would be the last query I would have as far this
bordering issue is concerned.

I have been breaking my head with this for past 36 hours trying to
figure out a way to solve my objective. With your help I am progressing
well but still landing into quite a lot of problems.

Just a minor mofication to the original problem statement.

Code below gives the resultant rng3 in the same worksheet. Assuming
that there are two identical sheets, I have a query pertaining to this.

Instead of displaying the result of Rng3 operations in the same
worksheet, is it possible to display it in the next worksheet?
For example, user selects two cells in sheet1 and the result (includes
merging, adding, color coding), instead of being displayed in the same
sheet, should be displayed in the next sheet (sheet2).

Thanks for all your help.
Sincerely,
Thulasiram

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Areas.Count = 2 Then
OutlineSelectedAreas2 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 RngTmp As 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

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
Application.DisplayAlerts = False
With Rng3
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Interior.ColorIndex = 6
.Value = Application.Sum(Rng3)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Application.DisplayAlerts = True

Set Rng1 = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
End Function



Thulasiram wrote:
Thanks a ton Mr.Bob

You have solved my six hour try on this situation.

Thanks again,
Thulasiram

Bob Phillips wrote:
Function OutlineSelectedAreas(ByRef Rng1 As Excel.Range, _
ByRef Rng2 As Excel.Range)
Dim Rng3 As Excel.Range
Dim RngTmp As 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

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
Application.DisplayAlerts = False
With Rng3
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Interior.ColorIndex = 6
.Value = Application.Sum(Rng3)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Application.DisplayAlerts = True

Set Rng1 = Nothing
Set Rng2 = Nothing
Set Rng3 = Nothing
End Function


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Thulasiram" wrote in message
oups.com...
Dear Bob,

This is in continuation with my previous post in this topic: I solved
part of my question in the previous topic but still struggling with the
later part of the question.

I have merged the cells using Rng3.merge as shown below.

But when this operation is performed, then Excel gives a message that
only the top value of the cell will be present after the cells are
merged. Is there any way to have the sum of rng3 (aligned in the middle
of the merged cell) after the cells are merged?

Please help

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
Rng3.Interior.ColorIndex = 6
Range("A1").Value = Application.Sum(Rng3)
Rng3.Merge

Thanks,
Thulasiram

Thulasiram wrote:
Dear Bob,

It works! Also, I have implemented another line that higlights the rng3
with a colorindex.

Is it possible to merge all the cells in the Rng3 into a single cell
and display only the sum in it?

Please help

Thanks,
Thulasiram.

Bob Phillips wrote:
Add this line


Range("A1").Value = Application.Sum(Rng3)

just before the last 3 lines in the function, the Set ... = Nothing
lines.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"Thulasiram" wrote in message
oups.com...
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



Reply With QuoteReply With Quote