Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > A query in continuation to the nested bordering - To TOM, JIM and others....
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 106
Default A query in continuation to the nested bordering - To TOM, JIM and others....
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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 10,593
Default A query in continuation to the nested bordering - To TOM, JIM and others....
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
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 106
Default A query in continuation to the nested bordering - To TOM, JIM and others....
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
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 106
Default A query in continuation to the nested bordering - To TOM, JIM and others....
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
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 10,593
Default A query in continuation to the nested bordering - To TOM, JIM and others....
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
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 106
Default A query in continuation to the nested bordering - To TOM, JIM and others....
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
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 106
Default A query in continuation to the nested bordering - To TOM, JIM and others....
Dear Mr.Bob,

The code works perfectly for intersection of the selected cells.

Now, I am trying to select only a single cell (instead of two cells).
Result should be a higlighted boundary for all the cells corresponding
to that selected merged cell. I have modified the code to suit this
condition. But the result is eratic.

Please help

Modified code for this single cell selection and the original code for
two cell selection are given below:

If Target.Areas.Count = 1 Then
' OutlineSelectedAreas2 Target.Areas(1), Target.Areas(2)
OutlineSelectedAreas3 Target.Areas(1)
End If

Function OutlineSelectedAreas3(ByRef Rng1 As Excel.Range)
' code for entirerow condition

Dim Rng3 As Excel.Range
Dim RngTmp As Range
'**********for one click*********************
' 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
.Interior.ColorIndex = 0
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)
Set Rng1 = RngTmp
Set Rng3 = Rng1.EntireRow
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

************* code for 2 cells selection ***************

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
  #8   Report Post  
Posted to microsoft.public.excel.programming
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
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 27,285
Default A query in continuation to the nested bordering - To TOM, JIM and others....
Provided Thulasiram a possible solution.

--
Regards,
Tom Ogilvy


"Thulasiram" wrote in message
ups.com...
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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Bordering in Excell olrjr Excel Discussion (Misc queries) 2 December 31st 08 11:51 PM
nested conditional query RayB Excel Discussion (Misc queries) 3 April 17th 08 05:04 PM
line bordering hidden cells EllenM Excel Discussion (Misc queries) 2 May 11th 07 11:47 AM
Bordering Ashish Mathur[_2_] Excel Programming 2 May 25th 05 06:22 AM
Cell bordering Albert Jameson Excel Programming 3 October 13th 04 05:18 AM


All times are GMT +1. The time now is 10:56 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement