A Function to summarize Selection properties

arishy · Mar 7, 2013

We all work with range object all the time. I love to have a function that will do the following:

1. the absolute address of the FOUR corners.(Top left,....)

2. the absolute and relative Last Row and Last Column.

3. Number of rows, and number of columns

4. Name of the selection(If any)

5. Is it a table or a range

6. Is there blank cells inside the selection or not(T/F)

7. Is there Formulae inside the range of pure values(T/F)

8. is there hidden rows/columns (T/F)

9. Contiguous (T/F)

And since everyone has his/her own way of labeling each property of the range we can provide that as well when you call the function with the selection.

I have the time to do it, but I need you guys and gals kick start me. IF VIABLE !!!!

Hui · Mar 7, 2013

Arishy

These can all be determined

What is the purpose ?

arishy · Mar 7, 2013

Here are few:

1. Fun to use

2. Consistency

3. Easy to maintain.

4. Save on testing

5. Avoid reinventing

6. Instead of macro bag full of parts, one for all.

Having said that, I am not sure if my idea in clear enough. So, let me try again;

Suppose I have some text in a cell. VBA can x-ray the text by giving you the property of the text: font color size etc .....

I want to do the same thing for the selected range. By having "my own lingo" I can say

Selection.TopleftAddress this will give $A$1

Selection.LastRowAbsolute this will give 5

Selection.NoOfRows this will give 3

For some one like you, you do that without any need for "extra" tool to do it.

For someone like me I need to go back to the library and search for the proper use.

There are a lot of excel users who are not programmers, and I thought this will help.

I love to have it myself but I need a "programmer" to help me out.

Hui · Mar 7, 2013

You could try something like:

[pre]

Code:

Function Range_Properties(Area As Range, Optional Scope As Variant = &#34;UL&#34;) As Variant
&#39;
&#39; Use =Range_Properties(Range, Scope)
&#39;
&#39; Scope
&#39; UL - Upper Left Cell (Default)
&#39; LL - Lower Left Cell
&#39; UR - Upper Right Cell
&#39; LR - Lower Right Cell
&#39; ALR - Absolute Last row
&#39; ALC - Absolute Last Column
&#39; RLR - Relative Last row
&#39; RLC - Relative Last Column
&#39; HF - Has a Formula
&#39; HB - Has a Blank

Dim curRange As Range
Set curRange = Selection

Dim myRng As String
myRng = Area.Address

D1 = 1
D2 = InStr(2, myRng, &#34;$&#34;)
D3 = InStr(D2 + 1, myRng, &#34;$&#34;)
D4 = InStr(D3 + 1, myRng, &#34;$&#34;)
myLen = Len(myRng)

Set rgLast = Range(myRng).SpecialCells(xlCellTypeLastCell)
lLastRow = Range(myRng).Row + Range(myRng).Rows.Count - 1
lLastCol = Range(myRng).Column + Range(myRng).Columns.Count - 1

Set curLast = Range(myRng).SpecialCells(xlCellTypeLastCell)
curLastRow = curRange.Row
curLastCol = curRange.Column

Select Case Scope
Case &#34;UL&#34;
&#39;UL Corner Cordinates
MSG = &#34;Top Left = &#34;
Range_Properties = MSG + Left(myRng, InStr(1, myRng, &#34;:&#34;) - 1)

Case &#34;UR&#34;
&#39;UR Corner Cordinates
MSG = &#34;Top Right = &#34;
Range_Properties = MSG + Mid(myRng, D3, D4 - D3) + Mid(myRng, D2, D3 - D2 - 1)

Case &#34;LL&#34;
&#39;LL Corner Cordinates
MSG = &#34;Lower Left = &#34;
Range_Properties = MSG + Left(myRng, D2 - 1) + Right(myRng, myLen - D4 + 1)

Case &#34;LR&#34;
&#39;LL Corner Cordinates
MSG = &#34;Bottom Right = &#34;
Range_Properties = MSG + Right(myRng, Len(myRng) - InStr(1, myRng, &#34;:&#34;))

Case &#34;ALR&#34;
&#39;Absolute Last Row
MSG = &#34;Last Row = Row: &#34;
Range_Properties = MSG + Right(myRng, myLen - D4)

Case &#34;ALC&#34;
&#39;Absolute Last Column
MSG = &#34;Last Column = Column: &#34;
Range_Properties = MSG + Mid(myRng, D3 + 1, D3 - D2 - 2)

Case &#34;RLR&#34;
&#39;Relative Last Row & Column
MSG = &#34;There are &#34; + Str(curLastRow - lLastRow) + &#34; Rows between current cell &#34; + Selection.Address + &#34; and the Last Row of &#34; + myRng
Range_Properties = MSG

Case &#34;RLC&#34;
&#39;Relative Last Row & Column
MSG = &#34;There are &#34; + Str(curLastCol - lLastCol) + &#34; Columns between current cell &#34; + Selection.Address + &#34; and the Last Column of &#34; + myRng
Range_Properties = MSG

Case &#34;HF&#34;
&#39;Determine if Contains a Formula
HasFormula = False
For Each c In Range(myRng)
If c.HasFormula = True Then
HasFormula = True
Exit For
End If
Next
If HasFormula Then
MSG = &#34;Range: &#34; + myRng + &#34; has a formula&#34;
Else
MSG = &#34;Range: &#34; + myRng + &#34; Doesn&#39;t have a formula&#34;
End If
Range_Properties = MSG

Case &#34;HB&#34;
&#39;Determine if Contains a Blank
HasBlank = False
For Each c In Range(myRng)
If c.Text = &#34;&#34; Then
HasBlank = True
Exit For
End If
Next
If HasBlank Then
MSG = &#34;Range: &#34; + myRng + &#34; has a Blank cell&#34;
Else
MSG = &#34;Range: &#34; + myRng + &#34; Doesn&#39;t have a Blank cell&#34;
End If
Range_Properties = MSG

&#39;Add more functions here

Case Else
Range_Properties = &#34;!Unknown Function&#34;
End Select

End Function

[/pre]

arishy · Mar 7, 2013

Wow .....You made my day.....

I will sit and "absorb" your wonderful work and give you my feedback.

Do appreciate very much taking the time to pursue a dream of mine.

Hui · Mar 7, 2013

Arishy

You will see how it can easily be adapted to add extra measurements

It could also be modified to say use this format

=Range_Properties(Range, Scope, Long/Short)

where Long is a verbose answer like what is presented above

and Short would simple return a Number or Range answer

eg:

=Range_Properties(A1:L14, "ALC", Long)

="Last Column = Column: 12"

=Range_Properties(A1:L14, "ALC", Short)

=12

Hui · Mar 7, 2013

So I added all the measure you listed initially

Including Table and Named Ranges intersections

As well as the Verbose answer options as well

eg:

=Range_properties(B2:H21,"NC")

=The Range: $B$2:$H$21 is 7 columns wide.

=Range_properties(B2:H21,"NC", false)

=7

and you can use Named Formula

=Range_properties(Test,"NC")

where test = B2:H21 etc

Code below

==================

Function Range_Properties(Area As Range, _
Optional Scope As Variant = "UL", _
Optional Verb As Boolean = True) _
As Variant
'
' Use =Range_Properties(Range, [Scope], [Verbose])
'
' Scope
' UL - Upper Left Cell (Default)
' LL - Lower Left Cell
' UR - Upper Right Cell
' LR - Lower Right Cell
' ALR - Absolute Last row
' ALC - Absolute Last Column
' RLR - Relative Last row
' RLC - Relative Last Column
' HF - Has a Formula
' HB - Has a Blank
' NR - Number Columns
' NC - Number Columns
' Name - Check if intersecting a Named Range/Formula
' Table - Check if intersecting a Table
'
' Verbose
' True - Long Answer (Default)
' False - Short Answer

Dim nm As Name
Dim oLo As ListObject
Dim curRange As Range
Set curRange = Selection

Dim myRng As String
myRng = Area.Address

D1 = 1
D2 = InStr(2, myRng, "$&#34

D3 = InStr(D2 + 1, myRng, "$&#34

D4 = InStr(D3 + 1, myRng, "$&#34

myLen = Len(myRng)

Set rgLast = Range(myRng).SpecialCells(xlCellTypeLastCell)
lLastRow = Range(myRng).Row + Range(myRng).Rows.Count - 1
lLastCol = Range(myRng).Column + Range(myRng).Columns.Count - 1

Set curLast = Range(myRng).SpecialCells(xlCellTypeLastCell)
curLastRow = curRange.Row
curLastCol = curRange.Column

Select Case Scope
Case "UL"
'UL Corner Cordinates
msg = "Top Left = "
If Verb = True Then
Range_Properties = msg + Left(myRng, InStr(1, myRng, ":&#34

- 1)
Else
Range_Properties = Left(myRng, InStr(1, myRng, ":&#34

- 1)
End If

Case "UR"
'UR Corner Cordinates
msg = "Top Right = "
If Verb = True Then
Range_Properties = msg + Mid(myRng, D3, D4 - D3) + Mid(myRng, D2, D3 - D2 - 1)
Else
Range_Properties = Mid(myRng, D3, D4 - D3) + Mid(myRng, D2, D3 - D2 - 1)
End If

Case "LL"
'LL Corner Cordinates
msg = "Lower Left = "
If Verb = True Then
Range_Properties = msg + Left(myRng, D2 - 1) + Right(myRng, myLen - D4 + 1)
Else
Range_Properties = Left(myRng, D2 - 1) + Right(myRng, myLen - D4 + 1)
End If

Case "LR"
'LL Corner Cordinates
msg = "Bottom Right = "
If Verb = True Then
Range_Properties = msg + Right(myRng, Len(myRng) - InStr(1, myRng, ":&#34

)
Else
Range_Properties = Right(myRng, Len(myRng) - InStr(1, myRng, ":&#34

)
End If

Case "ALR"
'Absolute Last Row
msg = "Last Row = Row: "
If Verb = True Then
Range_Properties = msg + Right(myRng, myLen - D4)
Else
Range_Properties = Right(myRng, myLen - D4)
End If

Case "ALC"
'Absolute Last Column
msg = "Last Column = Column: "
If Verb = True Then
Range_Properties = msg + Mid(myRng, D3 + 1, D3 - D2 - 2)
Else
Range_Properties = Mid(myRng, D3 + 1, D3 - D2 - 2)
End If

Case "RLR"
'Relative Last Row & Column
msg = "There are " + Str(curLastRow - lLastRow) + " Rows between current cell " + Selection.Address + " and the Last Row of " + myRng
If Verb = True Then
Range_Properties = msg
Else
Range_Properties = curLastRow - lLastRow
End If

Case "RLC"
'Relative Last Row & Column
msg = "There are " + Str(curLastCol - lLastCol) + " Columns between current cell " + Selection.Address + " and the Last Column of " + myRng
If Verb = True Then
Range_Properties = msg
Else
Range_Properties = curLastCol - lLastCol
End If

Case "HF"
'Determine if Contains a Formula
HasFormula = False
For Each c In Range(myRng)
If c.HasFormula = True Then
HasFormula = True
Exit For
End If
Next
If HasFormula Then
msg = "Range: " + myRng + " has a formula"
Else
msg = "Range: " + myRng + " Doesn't have a formula"
End If
If Verb = True Then
Range_Properties = msg
Else
Range_Properties = False
End If

Case "HB"
'Determine if Contains a Blank
HasBlank = False
For Each c In Range(myRng)
If c.Text = "" Then
HasBlank = True
Exit For
End If
Next
If HasBlank Then
msg = "Range: " + myRng + " has a Blank cell"
Else
msg = "Range: " + myRng + " Doesn't have a Blank cell"
End If
If Verb = True Then
Range_Properties = msg
Else
Range_Properties = False
End If

Case "NR"
'Number of Rows
msg = "The Range: " + myRng + " is " + Str(Range(myRng).Rows.Count) + " rows high."
If Verb = True Then
Range_Properties = msg
Else
Range_Properties = Range(myRng).Rows.Count
End If

Case "NC"
'Number of Columns
msg = "The Range: " + myRng + " is " + Str(Range(myRng).Columns.Count) + " columns wide."
If Verb = True Then
Range_Properties = msg
Else
Range_Properties = Range(myRng).Columns.Count
End If

Case "Name"
msg = False
For Each nm In ThisWorkbook.Names
Set rng = Intersect(Area, Range(nm.Name))
If Not rng Is Nothing Then
msg = "The range: " + Area.Address + " intersects the Named Range: " & nm.Name
Exit For
End If
Next nm

If Verb = True Then
Range_Properties = msg
Else
If Not rng Is Nothing Then
Range_Properties = True
Else
Range_Properties = False
End If
End If

Case "Table"

msg = False
For Each oLo In ActiveSheet.ListObjects
Application.Goto oLo.Range
Set rng = Intersect(Area, oLo.DataBodyRange)
If Not rng Is Nothing Then
msg = "The range: " + Area.Address + " intersects the Table: " & oLo.Name
Exit For
End If
Next

If Verb = True Then
Range_Properties = msg
Else
If Not rng Is Nothing Then
Range_Properties = True
Else
Range_Properties = False
End If
End If

'Add more functions here

Case Else
Range_Properties = "!Unknown Function"
End Select

End Function

arishy · Mar 8, 2013

Hi Hui,

As I mentioned before I have all the time in the world, and I have the feeling that your work will keep me busy for some time. The challenge of course, is you. How I can keep you interested without "you regretting it".!!! I will just played by ear AND cross my fingers.

I have several avenues, but I will start by the code while it is fresh in your mind.

"HB" detected the blank cell , but after putting something there, it remained with "Has a blank". I believe this is a general issue with VBA ( Clear All ).

Just a short note on the subject of (several avenues!). To give you an example.

The "Lingo" that you kindly came up with is close to excel's heart !! I mean HB can be taken as column HB .. So, we need to come up with possible alternative. I will stop here.

Another avenue ( too advanced for me to even discuss ) is to create our own CLASS, so we can use the dot notation. Again, I will stop here for the sake of not boring you.

Hui · Mar 8, 2013

If you add the line

Code:

Application.Volatile

Up near the top after the Dim statements

That should force it to recalculate every time the sheet is recalculated

You are free to choose whatever acronym's or Numbers that take your fancy

I just think HB is more intuitive than 12

I'm not into Classes but should be so don't bother asking

arishy · Mar 8, 2013

Actually, the beauty of your code, is not only "use your own lingo" , but the infinite possibility of ADDING new features!!!. And that where I will be spending most of my time. I will keep you posted.

Classes ? what classes ...Never heard of them.

A Function to summarize Selection properties

arishy

Member

Hui

Excel Ninja

arishy

Member

Hui

Excel Ninja

arishy

Member

Hui

Excel Ninja

Hui

Excel Ninja

arishy

Member

Hui

Excel Ninja

arishy

Member