VBA to identify top left cell of a selected range

[exceluser2007]

Hi All,

I'm curious to know, that if a user has selected a range, how do you, in VBA, identify the:

1. Top left cell
2. Bottom left cell
3. Top right cell
4. Bottom right cell

For example if user has selected the range B5:M30, then we would want to identify in the macro:

1. Top left cell = B5
2. Bottom left cell = B30
3. Top right cell = M5
4. Bottom right cell = M30

Any help appreciated.

 

[Tom Urtis]

Sub Test1() 
With Selection
MsgBox _
"Top left: " & vbCrLf & _
"row - " & .Row & vbCrLf & _
"column - " & .Column & vbCrLf & _
"address - " & Cells(.Row, .Column).Address(0, 0) & vbCrLf & vbCrLf & _
"Top right: " & vbCrLf & _
"row - " & .Row & vbCrLf & _
"column - " & .Columns.Count + .Column - 1 & vbCrLf & _
"address - " & Cells(.Row, .Columns.Count + .Column - 1).Address(0, 0) & vbCrLf & vbCrLf & _
"Lower left: " & vbCrLf & _
"row - " & .Rows.Count + .Row - 1 & vbCrLf & _
"column - " & .Column & vbCrLf & _
"address - " & Cells(.Rows.Count + .Row - 1, .Column).Address(0, 0) & vbCrLf & vbCrLf & _
"Lower right: " & vbCrLf & _
"row - " & .Rows.Count + .Row - 1 & vbCrLf & _
"column - " & .Columns.Count + .Column - 1 & vbCrLf & _
"address - " & Cells(.Rows.Count + .Row - 1, .Columns.Count + .Column - 1).Address(0, 0) & vbCrLf & vbCrLf & _
"The selection address is " & .Address(0, 0) & vbCrLf & _
"The quantity of cells selected is " & .Cells.Count, , "Selection info:"
End With
End Sub

Other way of looking at it:

 Sub Test2()
Dim cell As Range, MergeVal$
Dim TR&, BR&, LC%, RC%
With Selection
TR = .row
BR = .Rows.Count + .row - 1
LC = .Column
RC = .Columns.Count + .Column - 1
MsgBox _
"Top row: " & TR & vbCrLf & _
"Bottom row: " & BR & vbCrLf & _
"Left Column: " & LC & vbCrLf & _
"Right column: " & RC
End With
End Sub

 

[jindon]

Sub test()
With Selection
    MsgBox "1. Top left cell = " & .Cells(1).Address(0,0) & vbLf & _
           "2. Bottom left cell = " & .Cells(.Rows.Count,1).Address(0,0) & vbLf &  _
           "3. Top right cell = " & .Cells(1, .Columns.Count).Address(0,0) & vbLf & _
           "4. Bottom right cell = " & .Cells(.Cells.Count).Address(0,0)
End with
End Sub

 

[exceluser2007]

Tom,

Thanks (as always) for your great code:

I've just modified your code slightly (to improve my error handling) as follows:

Option Explicit

Sub DisplayCorner_Addresses_of_Selection()

' For a given selection, displays the
'  1. Top left cell
'  2. Bottom left cell
'  3. Top right cell
'  4. Bottom right cell
'     as String addresses in a MsgBox

    Dim TopRow_Selection As Long, BottomRow_Selection As Long, LeftCol_Selection As Long, RightCol_Selection As Long
    Dim TopLeftCel_Selection As String, BottomLeftCel_Selection As String, TopRightCel_Selection As String, BottomRightCel_Selection As String

    With Selection

        Select Case .Cells.Count

        Case Is <= 0

            GoTo error_handler

        Case Else

            TopRow_Selection = .Row
            BottomRow_Selection = .Rows.Count + .Row - 1
            LeftCol_Selection = .Column
            RightCol_Selection = .Columns.Count + .Column - 1

            TopLeftCel_Selection = Cells(Selection.Row, Selection.Column).Address

            BottomLeftCel_Selection = Cells(Selection.Rows.Count + Selection.Row - 1, Selection.Column).Address

            TopRightCel_Selection = Cells(Selection.Row, Selection.Columns.Count + Selection.Column - 1).Address

            BottomRightCel_Selection = Cells(Selection.Rows.Count + Selection.Row - 1, Selection.Columns.Count + Selection.Column - 1).Address

            MsgBox "Top row: " & TopRow_Selection & vbCrLf & "Bottom row: " & BottomRow_Selection & vbCrLf & "Left Column: " & LeftCol_Selection & vbCrLf & "Right column: " & RightCol_Selection & vbCrLf & vbCrLf & "Top Left Cell: " & TopLeftCel_Selection & vbCrLf & "Bottom Left Cell: " & BottomLeftCel_Selection & vbCrLf & "Top Right Cell: " & TopRightCel_Selection & vbCrLf & "Bottom Right Cell: " & BottomRightCel_Selection

        End Select

    End With

    Exit Sub

error_handler:

    Call MsgBox("You haven't made a a valid selection of cells:" & vbCrLf & "" _
              & vbCrLf & "Please select a SINGLE or MULTIPLE cells and re-run this macro.", _
                vbCritical, "Selection Invalid")

End Sub

2 things though:

1. The error handling doesn't seem to check whether a valid range is selected i.e. I you click on an active chart in the same worksheet and try to run it, it just crashes (without going through the error handler). What is the method to correct the error handling for this?

2. Is there a better (shorter/ slicker/ more efficient) way to write the above?

regards

 

[exceluser2007]

jindon, also many thanks for your elegant code.

Saw your message after I posted my second one.

As per my queries to Tom, is there any way to handle the errors. The main one I was trying to cover was that a valid range is selected before the macro is run. Though it failed when a chart was activated before running.

Please note that this macro will be part of a much larger range of tools I am trying to build (in understanding VBA better), hence all the queries over a relatively simple macro output exercise.

regards,

 

[Tom Urtis]

As per my queries to Tom, is there any way to handle the errors. The main one I was trying to cover was that a valid range is selected before the macro is run. Though it failed when a chart was activated before running.

You can determine the type of object that is selected, and only proceed when the type is a range, example:

If TypeName(Selection) = "Range" Then
MsgBox "OK to proceed"
Else
MsgBox "Range of cells not selected, cannot continue"
End If


You might not need to select a range at all, cannot tell what you are doing in the bigger picture scheme, but TypeName should get you what you need.

 

[jindon]

Not sure what you are trying to do though

Sub test()
If Intersect(Selection, Range("YourRangeHere")) Is Nothing Then
    MsgBox "Not overwrapping"
Else
    MsgBox "Overwrapping"
End If
End Sub

 

[Tom Urtis]

Not sure what you are trying to do though

Sub test()
If Intersect(Selection, Range("YourRangeHere")) Is Nothing Then
    MsgBox "Not overwrapping"
Else
    MsgBox "Overwrapping"
End If
End Sub

The issue is not a particular range of cells, but if a range of cells is selected at all, as opposed to a chart or some object being selected at the time of macro execution that is not a worksheet cell range.

 

[exceluser2007]

Hi jindon and Tom,

Thanks for those methods, worked brilliantly.

What I hope to do by the end of all this is just some UDF's to work with diagonals better e.g. sum diagonal, average diagonal, border diagonals use this stuff for work and the current UDF's are easy to crash, so having a go myself.

Will be posting back on this stuff with more queries though!

regards

 

[exceluser2007]

Tom, as per your post #8, yep that's right, your post directly answered my question.

I also tested jindon's method for checking intersecting ranges, and it worked great. A new technique in the toolkit in bag in case I need to check for intersecting ranges whilst making the macros and UDFs!