Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to merge all selected areas into one area
Dear all, Although I am a quite experienced programmer in C, I have just starte learning VBA and experimenting with it through a small project i Excel. I am reading and searching to find answers to my questions, bu still there are some things that are too hard for me to solve at thi point. Therefore, I would be grateful if you could help me a littl bit. What I am trying to do is the following: On an active worksheet, I a selecting some areas. Let's use as an example areas C5:D9, D15:E18 G8:I16 and J3:M13. I would like to create a new selection that contain all the above selections and is (visually) a rectangle. For the abov example this would be area C3:M18. It is a rectangle that starts at th left-most column (C) and upper-most row (3) and ends at the right-mos column (M) and lowest row (18) of all the selected areas. I have code the following solution, but I am not certain whether it is optimal: - Global definitions Public OriginalSelection As Range, WorkingRange As Range - In a subroutine Dim i As Long Dim TopRow As Long, BottomRow As Long Dim LeftColumn As Long, RightColumn As Long If Selection Is Nothing Then GoTo ErrorMsg End If If TypeName(Selection) < "Range" Then GoTo ErrorMsg End If Set OriginalSelection = Selection ' ' Find the upper-left cell selected ' TopRow = ActiveSheet.Rows.Count LeftColumn = ActiveSheet.Columns.Count For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row < TopRow Then TopRow = Selection.Areas(i).Row End If If Selection.Areas(i).Column < LeftColumn Then LeftColumn = Selection.Areas(i).Column End If Next i ' ' Find the bottom-right cell selected ' BottomRow = TopRow RightColumn = LeftColumn For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row + Selection.Areas(i).Rows.Count BottomRow Then BottomRow = Selection.Areas(i).Row Selection.Areas(i).Rows.Count - 1 End If If Selection.Areas(i).Column + Selection.Areas(i).Columns.Coun RightColumn Then RightColumn = Selection.Areas(i).Column Selection.Areas(i).Columns.Count - 1 End If Next i ' ' Work with the range that starts at the upper-left cell ' and ends at the bottom-right one ' Set WorkingRange = ActiveSheet.Range(Cells(TopRow, LeftColumn) Cells(BottomRow - TopRow + 1, RightColumn - LeftColumn + 1)) WorkingRange.Select Exit Sub ErrorMsg: MsgBox "Please select a range of cells!", vbOKOnly + vbCritical This works, but as I already mentioned, I don't know if this is th best way to do it. Any comments? Thank you in advance, Ioanni -- ie ----------------------------------------------------------------------- iev's Profile: http://www.excelforum.com/member.php...fo&userid=2675 View this thread: http://www.excelforum.com/showthread.php?threadid=40007 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to merge all selected areas into one area
Here is a function that takes your input selection and returns the total
area extent of the entire selection group. Function GetBigArea(InRange As Range) As Range Dim x As Long, frow As Long, lrow As Long, fcol As Long, lcol As Long frow = Rows.Count: lrow = 0: fcol = Columns.Count: lcol = 0 With InRange For x = 1 To .Areas.Count If frow .Areas(x).Row Then frow = .Areas(x).Row If .Areas(x).Row + .Areas(x).Rows.Count - 1 lrow Then _ lrow = .Areas(x).Row + .Areas(x).Rows.Count - 1 If fcol .Areas(x).Column Then fcol = .Areas(x).Column If .Areas(x).Column + .Areas(x).Columns.Count - 1 lcol Then _ lcol = .Areas(x).Column + .Areas(x).Columns.Count - 1 Next x End With -- Cheers Nigel "iev" wrote in message ... Dear all, Although I am a quite experienced programmer in C, I have just started learning VBA and experimenting with it through a small project in Excel. I am reading and searching to find answers to my questions, but still there are some things that are too hard for me to solve at this point. Therefore, I would be grateful if you could help me a little bit. What I am trying to do is the following: On an active worksheet, I am selecting some areas. Let's use as an example areas C5:D9, D15:E18, G8:I16 and J3:M13. I would like to create a new selection that contains all the above selections and is (visually) a rectangle. For the above example this would be area C3:M18. It is a rectangle that starts at the left-most column (C) and upper-most row (3) and ends at the right-most column (M) and lowest row (18) of all the selected areas. I have coded the following solution, but I am not certain whether it is optimal: - Global definitions Public OriginalSelection As Range, WorkingRange As Range - In a subroutine Dim i As Long Dim TopRow As Long, BottomRow As Long Dim LeftColumn As Long, RightColumn As Long If Selection Is Nothing Then GoTo ErrorMsg End If If TypeName(Selection) < "Range" Then GoTo ErrorMsg End If Set OriginalSelection = Selection ' ' Find the upper-left cell selected ' TopRow = ActiveSheet.Rows.Count LeftColumn = ActiveSheet.Columns.Count For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row < TopRow Then TopRow = Selection.Areas(i).Row End If If Selection.Areas(i).Column < LeftColumn Then LeftColumn = Selection.Areas(i).Column End If Next i ' ' Find the bottom-right cell selected ' BottomRow = TopRow RightColumn = LeftColumn For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row + Selection.Areas(i).Rows.Count BottomRow Then BottomRow = Selection.Areas(i).Row + Selection.Areas(i).Rows.Count - 1 End If If Selection.Areas(i).Column + Selection.Areas(i).Columns.Count RightColumn Then RightColumn = Selection.Areas(i).Column + Selection.Areas(i).Columns.Count - 1 End If Next i ' ' Work with the range that starts at the upper-left cell ' and ends at the bottom-right one ' Set WorkingRange = ActiveSheet.Range(Cells(TopRow, LeftColumn), Cells(BottomRow - TopRow + 1, RightColumn - LeftColumn + 1)) WorkingRange.Select Exit Sub ErrorMsg: MsgBox "Please select a range of cells!", vbOKOnly + vbCritical This works, but as I already mentioned, I don't know if this is the best way to do it. Any comments? Thank you in advance, Ioannis -- iev ------------------------------------------------------------------------ iev's Profile: http://www.excelforum.com/member.php...o&userid=26752 View this thread: http://www.excelforum.com/showthread...hreadid=400070 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to merge all selected areas into one area
.... sorry missed the last two rows out of the function!!
Set GetBigArea = Range(Cells(frow, fcol), Cells(lrow, lcol)) End Function -- Cheers Nigel "Nigel" wrote in message ... Here is a function that takes your input selection and returns the total area extent of the entire selection group. Function GetBigArea(InRange As Range) As Range Dim x As Long, frow As Long, lrow As Long, fcol As Long, lcol As Long frow = Rows.Count: lrow = 0: fcol = Columns.Count: lcol = 0 With InRange For x = 1 To .Areas.Count If frow .Areas(x).Row Then frow = .Areas(x).Row If .Areas(x).Row + .Areas(x).Rows.Count - 1 lrow Then _ lrow = .Areas(x).Row + .Areas(x).Rows.Count - 1 If fcol .Areas(x).Column Then fcol = .Areas(x).Column If .Areas(x).Column + .Areas(x).Columns.Count - 1 lcol Then _ lcol = .Areas(x).Column + .Areas(x).Columns.Count - 1 Next x End With -- Cheers Nigel "iev" wrote in message ... Dear all, Although I am a quite experienced programmer in C, I have just started learning VBA and experimenting with it through a small project in Excel. I am reading and searching to find answers to my questions, but still there are some things that are too hard for me to solve at this point. Therefore, I would be grateful if you could help me a little bit. What I am trying to do is the following: On an active worksheet, I am selecting some areas. Let's use as an example areas C5:D9, D15:E18, G8:I16 and J3:M13. I would like to create a new selection that contains all the above selections and is (visually) a rectangle. For the above example this would be area C3:M18. It is a rectangle that starts at the left-most column (C) and upper-most row (3) and ends at the right-most column (M) and lowest row (18) of all the selected areas. I have coded the following solution, but I am not certain whether it is optimal: - Global definitions Public OriginalSelection As Range, WorkingRange As Range - In a subroutine Dim i As Long Dim TopRow As Long, BottomRow As Long Dim LeftColumn As Long, RightColumn As Long If Selection Is Nothing Then GoTo ErrorMsg End If If TypeName(Selection) < "Range" Then GoTo ErrorMsg End If Set OriginalSelection = Selection ' ' Find the upper-left cell selected ' TopRow = ActiveSheet.Rows.Count LeftColumn = ActiveSheet.Columns.Count For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row < TopRow Then TopRow = Selection.Areas(i).Row End If If Selection.Areas(i).Column < LeftColumn Then LeftColumn = Selection.Areas(i).Column End If Next i ' ' Find the bottom-right cell selected ' BottomRow = TopRow RightColumn = LeftColumn For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row + Selection.Areas(i).Rows.Count BottomRow Then BottomRow = Selection.Areas(i).Row + Selection.Areas(i).Rows.Count - 1 End If If Selection.Areas(i).Column + Selection.Areas(i).Columns.Count RightColumn Then RightColumn = Selection.Areas(i).Column + Selection.Areas(i).Columns.Count - 1 End If Next i ' ' Work with the range that starts at the upper-left cell ' and ends at the bottom-right one ' Set WorkingRange = ActiveSheet.Range(Cells(TopRow, LeftColumn), Cells(BottomRow - TopRow + 1, RightColumn - LeftColumn + 1)) WorkingRange.Select Exit Sub ErrorMsg: MsgBox "Please select a range of cells!", vbOKOnly + vbCritical This works, but as I already mentioned, I don't know if this is the best way to do it. Any comments? Thank you in advance, Ioannis -- iev ------------------------------------------------------------------------ iev's Profile: http://www.excelforum.com/member.php...o&userid=26752 View this thread: http://www.excelforum.com/showthread...hreadid=400070 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to merge all selected areas into one area
I think you can cut it down to one loop and use the actual addressess rather
than offsets. but the basic approach is correct since you can't depend on a multi area range being in any particular order. Sub AAAA() Dim i As Long, j As Long Dim TopRow As Long, BottomRow As Long Dim LeftColumn As Long, RightColumn As Long If Selection Is Nothing Then GoTo ErrorMsg End If If TypeName(Selection) < "Range" Then GoTo ErrorMsg End If With ActiveSheet TopRow = .UsedRange.Rows( _ .UsedRange.Rows.Count).Row LeftColumn = .UsedRange.Columns( _ .UsedRange.Columns.Count).Column BottomRow = .UsedRange.Row Rightrow = .UsedRange.Row End With Set OriginalSelection = Selection ' ' Find the upper-left cell selected ' For Each ar In Selection If ar.Row < TopRow Then TopRow = ar.Row End If If ar.Column < LeftColumn Then LeftColumn = ar.Column End If i = ar.Rows(ar.Rows.Count).Row j = ar.Columns(ar.Columns.Count).Column If i BottomRow Then BottomRow = i End If If j RightColumn Then RightColumn = j End If Next ' ' Work with the range that starts at the upper-left cell ' and ends at the bottom-right one ' Set WorkingRange = Range(Cells(TopRow, LeftColumn), _ Cells(BottomRow, RightColumn)) WorkingRange.Select Exit Sub ErrorMsg: MsgBox "Please select a range of cells!", vbOKOnly + vbCritical End Sub -- Regards, Tom Ogilvy "iev" wrote in message ... Dear all, Although I am a quite experienced programmer in C, I have just started learning VBA and experimenting with it through a small project in Excel. I am reading and searching to find answers to my questions, but still there are some things that are too hard for me to solve at this point. Therefore, I would be grateful if you could help me a little bit. What I am trying to do is the following: On an active worksheet, I am selecting some areas. Let's use as an example areas C5:D9, D15:E18, G8:I16 and J3:M13. I would like to create a new selection that contains all the above selections and is (visually) a rectangle. For the above example this would be area C3:M18. It is a rectangle that starts at the left-most column (C) and upper-most row (3) and ends at the right-most column (M) and lowest row (18) of all the selected areas. I have coded the following solution, but I am not certain whether it is optimal: - Global definitions Public OriginalSelection As Range, WorkingRange As Range - In a subroutine Dim i As Long Dim TopRow As Long, BottomRow As Long Dim LeftColumn As Long, RightColumn As Long If Selection Is Nothing Then GoTo ErrorMsg End If If TypeName(Selection) < "Range" Then GoTo ErrorMsg End If Set OriginalSelection = Selection ' ' Find the upper-left cell selected ' TopRow = ActiveSheet.Rows.Count LeftColumn = ActiveSheet.Columns.Count For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row < TopRow Then TopRow = Selection.Areas(i).Row End If If Selection.Areas(i).Column < LeftColumn Then LeftColumn = Selection.Areas(i).Column End If Next i ' ' Find the bottom-right cell selected ' BottomRow = TopRow RightColumn = LeftColumn For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row + Selection.Areas(i).Rows.Count BottomRow Then BottomRow = Selection.Areas(i).Row + Selection.Areas(i).Rows.Count - 1 End If If Selection.Areas(i).Column + Selection.Areas(i).Columns.Count RightColumn Then RightColumn = Selection.Areas(i).Column + Selection.Areas(i).Columns.Count - 1 End If Next i ' ' Work with the range that starts at the upper-left cell ' and ends at the bottom-right one ' Set WorkingRange = ActiveSheet.Range(Cells(TopRow, LeftColumn), Cells(BottomRow - TopRow + 1, RightColumn - LeftColumn + 1)) WorkingRange.Select Exit Sub ErrorMsg: MsgBox "Please select a range of cells!", vbOKOnly + vbCritical This works, but as I already mentioned, I don't know if this is the best way to do it. Any comments? Thank you in advance, Ioannis -- iev ------------------------------------------------------------------------ iev's Profile: http://www.excelforum.com/member.php...o&userid=26752 View this thread: http://www.excelforum.com/showthread...hreadid=400070 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to merge all selected areas into one area
iev wrote:
Dear all, Although I am a quite experienced programmer in C, I have just started learning VBA and experimenting with it through a small project in Excel. I am reading and searching to find answers to my questions, but still there are some things that are too hard for me to solve at this point. Therefore, I would be grateful if you could help me a little bit. What I am trying to do is the following: On an active worksheet, I am selecting some areas. Let's use as an example areas C5:D9, D15:E18, G8:I16 and J3:M13. I would like to create a new selection that contains all the above selections and is (visually) a rectangle. For the above example this would be area C3:M18. It is a rectangle that starts at the left-most column (C) and upper-most row (3) and ends at the right-most column (M) and lowest row (18) of all the selected areas. I have coded the following solution, but I am not certain whether it is optimal: - Global definitions Public OriginalSelection As Range, WorkingRange As Range - In a subroutine Dim i As Long Dim TopRow As Long, BottomRow As Long Dim LeftColumn As Long, RightColumn As Long If Selection Is Nothing Then GoTo ErrorMsg End If If TypeName(Selection) < "Range" Then GoTo ErrorMsg End If Set OriginalSelection = Selection ' ' Find the upper-left cell selected ' TopRow = ActiveSheet.Rows.Count LeftColumn = ActiveSheet.Columns.Count For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row < TopRow Then TopRow = Selection.Areas(i).Row End If If Selection.Areas(i).Column < LeftColumn Then LeftColumn = Selection.Areas(i).Column End If Next i ' ' Find the bottom-right cell selected ' BottomRow = TopRow RightColumn = LeftColumn For i = 1 To Selection.Areas.Count If Selection.Areas(i).Row + Selection.Areas(i).Rows.Count BottomRow Then BottomRow = Selection.Areas(i).Row + Selection.Areas(i).Rows.Count - 1 End If If Selection.Areas(i).Column + Selection.Areas(i).Columns.Count RightColumn Then RightColumn = Selection.Areas(i).Column + Selection.Areas(i).Columns.Count - 1 End If Next i ' ' Work with the range that starts at the upper-left cell ' and ends at the bottom-right one ' Set WorkingRange = ActiveSheet.Range(Cells(TopRow, LeftColumn), Cells(BottomRow - TopRow + 1, RightColumn - LeftColumn + 1)) WorkingRange.Select Exit Sub ErrorMsg: MsgBox "Please select a range of cells!", vbOKOnly + vbCritical This works, but as I already mentioned, I don't know if this is the best way to do it. Any comments? Didn't seem to work for me; it selected C3:K16. Alan Beban |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to merge all selected areas into one area
Hello again, Alan, you are right. The code I posted is incorrect. I was trying som things and posted incorrect code. The error is at the line: Set WorkingRange = ActiveSheet.Range(Cells(TopRow, LeftColumn) Cells(BottomRow - TopRow + 1, RightColumn - LeftColumn + 1)) near the end of the code. It should be: Set WorkingRange = ActiveSheet.Range(ActiveSheet.Cells(TopRow LeftColumn), ActiveSheet.Cells(BottomRow, RightColumn)) I would like to thank all others who replied. I will study your cod and try to incorporate it into my code. Thank you all for your help! Ioanni -- ie ----------------------------------------------------------------------- iev's Profile: http://www.excelforum.com/member.php...fo&userid=2675 View this thread: http://www.excelforum.com/showthread.php?threadid=40007 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Area Chart with Shaded Areas Diff. Color | Charts and Charting in Excel | |||
Pritning 2 selected areas of a sheet | Excel Worksheet Functions | |||
Unselect all selected areas in all sheets | Excel Discussion (Misc queries) | |||
grid lines - off in selected areas | Excel Discussion (Misc queries) | |||
Saving selected areas | Excel Discussion (Misc queries) |