Challenge: Triangle Area Select tool

[xluser2007]

Hi All,

At work we often work with triangulated data in Excel.

As such, could anyone please show how to code in the most robust and elegant manner a macro to sleect a triangular area if a vertical column is selected.

I have attached a picture to show the selected column, and the target output i.e. a top-triangle selection, with the bottom left cell being the "Activecell".

If anyone could please assist in writing the macro that would be appreciated.

regards,

[xluser2007]

And here is the target output i.e. the triangular area selected based on the orginal vertical column selected.

Any help sincerely appreciated.

[HaHoBe]

Hi,

no error handling included, no check for more than one selected area or more than one column:


Dim lngCounter As Long
Dim lngRowCount As Long
Dim rngTriang As Range

Set rngTriang = Selection
lngRowCount = rngTriang.Row

For lngCounter = Selection.Rows.Count To 1 Step -1
Set rngTriang = Union(rngTriang, Range(Cells(lngRowCount, Selection.Column), Cells(lngRowCount, Selection.Column + lngCounter - 1)))
lngRowCount = lngRowCount + 1
Next lngCounter

rngTriang.Select

Set rngTriang = Nothing Ciao,
Holger

[mdmackillop]

.....with the bottom left cell being the "Activecell"
A couple of lines more for the ActiveCell part


Dim lngCounter As Long
Dim lngRowCount As Long
Dim rngTriang As Range
Dim AC As Range

Set rngTriang = Selection
Set AC = rngTriang(rngTriang.Cells.Count)

lngRowCount = rngTriang.Row
For lngCounter = Selection.Rows.Count To 1 Step -1
Set rngTriang = Union(rngTriang, Range(Cells(lngRowCount, Selection.Column), Cells(lngRowCount, Selection.Column + lngCounter - 1)))
lngRowCount = lngRowCount + 1
Next lngCounter

rngTriang.Select
AC.Activate

Set rngTriang = Nothing
Set AC = Nothing

[mdmackillop]

Hi Holger,
If you use the green VBA button, rather than Code tags, your code will be formatted as shown.
Regards
MD

[mdmackillop]

Elegance is in the eye of the beholder. No "better" than Holgers code, just a different method of referencing.

Dim x As Long, y As Long, z As Long
Dim rngTriang As Range
Dim Rng As Range
Set Rng = ActiveCell
Set rngTriang = Rng
x = Selection.Cells.Count
For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, Rng.Offset(y).Resize(, z))
y = y + 1
Next
rngTriang.Select
Rng.Offset(x - 1).Activate
Set rngTriang = Nothing

[Bob Phillips]

Public Function Triangulate()
Dim NumRows As Long
Dim Addrows As Long
Dim rng As Range

Set rng = Selection
NumRows = rng.Rows.Count
Call TriangulateNext(rng, NumRows, Addrows)
rng.Select
rng.Cells(rng.Areas(1).Rows.Count, 1).Activate
End Function

Private Function TriangulateNext(ByRef rng As Range, ByRef NumRows As Long, ByRef Addrows As Long)

NumRows = NumRows - 1
Addrows = Addrows + 1
If NumRows > 0 Then

Set rng = Union(rng, rng.Areas(1).Offset(0, NumRows).Resize(Addrows))
Call TriangulateNext(rng, NumRows, Addrows)
End If
End Function

[p45cal]

not necessarily more efficient nor elegant but a different approachSub blah()
Set rng = Selection
Set AC = rng(rng.Cells.Count)
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If cll.Column - Selection.Column + cll.Row - Selection.Row < Selection.Rows.Count then Set rng = Union(rng, cll)
Next cll
rng.Select
AC.Activate
End Sub and with fewer calculations:Sub blah()
Set rng = Selection
Set AC = rng(rng.Cells.Count)
ddd = rng.Row + rng.Column + rng.Rows.Count
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If cll.Column + cll.Row < ddd Then Set rng = Union(rng, cll)
Next cll
rng.Select
AC.Activate
End Sub

[xluser2007]

Holger, mdm, and Bob,

All brilliant solutions to the problem. I had not used Union before, so brilliant to learn from.

I have just a few queries and amendments that i would like to make. Could you please kindly assist. Bob, the way you have structured your solution with the "TraingulateNext" Function may lend itself naturally to the following extensions:

How can one error-handle the case where the user selects a chart and runs the macro instead of a column of cells?

If the user selects more than one column of contagious cells, then I would only like the traingle to extend from the first column, i.e. ideally one should only select one vertical column, but if they select more than one then triangulate from the first column.
If the user selects a bunch of non-contagious columns of cells, then again I would like to only start from the first column area and triangulate from there.
At work we also do the following triangulations (Please see attached picture below for the types of traingulations and diagonl-only selections). Could the macros be easily extended to allow for these combinations? Bob, in particular I feel that your TriangulateNext UDF could eb catered for this, but I am finding it hard to adapt.- The combinations are Bottom Left, Bottom-Right, Top-Left (which you have already done), Top-Right, Diagonal Left-to-Right, and Diagonal Right-to_Left.

Thanks sincerely for your kind help offered thus far, any help to extend this is appreciated.

If the above can be easily acheived then, I would like to make this as an addin for my personal use at work. This would be amazingly helpful :).

[xluser2007]

not necessarily more efficient nor elegant but a different approachSub blah()
Set rng = Selection
Set AC = rng(rng.Cells.Count)
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If cll.Column - Selection.Column + cll.Row - Selection.Row < Selection.Rows.Count then Set rng = Union(rng, cll)
Next cll
rng.Select
AC.Activate
End Sub and with fewer calculations:Sub blah()
Set rng = Selection
Set AC = rng(rng.Cells.Count)
ddd = rng.Row + rng.Column + rng.Rows.Count
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If cll.Column + cll.Row < ddd Then Set rng = Union(rng, cll)
Next cll
rng.Select
AC.Activate
End Sub


Hi pascal,

I just saw your elegant solution.

Really learning so many techniques from VBAX experts.

Thank you kindly.

[xluser2007]

I have just attached the following workbook, which has your macros set up with buttons for ease of testing purposes.

[p45cal]

all of 'em:Sub blah() 'top left
Set rng = Selection
Set AC = rng(rng.Cells.Count)
ddd = rng.Row + rng.Column + rng.Rows.Count
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If cll.Column + cll.Row < ddd Then Set rng = Union(rng, cll)
Next cll
rng.Select
AC.Activate
End Sub
Sub blah3() 'bottom left
Set rng = Selection
Set AC = rng(rng.Cells.Count)
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If (cll.Column - Selection.Column + 1) / (cll.Row - Selection.Row + 1) <= 1 Then Set rng = Union(rng, cll)
Next cll
rng.Select
AC.Activate
End Sub
Sub blah4() 'top right
Set rng = Selection
Set newrng = Selection.Cells(1)
Set AC = Selection.Cells(1)
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If (cll.Column - Selection.Column + 1) / (cll.Row - Selection.Row + 1) >= 1 Then Set newrng = Union(newrng, cll)
Next cll
newrng.Select
AC.Activate
End Sub
Sub blah5() 'diagonal top left to bottom right
Set rng = Selection
Set newrng = Selection.Cells(1)
Set AC = Selection.Cells(1)
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If (cll.Column - Selection.Column + 1) / (cll.Row - Selection.Row + 1) = 1 Then Set newrng = Union(newrng, cll)
Next cll
newrng.Select
AC.Activate
End Sub
Sub blah6() 'diagonal bottom left to top right
Set rng = Selection
Set AC = rng(rng.Cells.Count)
Set newrng = AC
ddd = rng.Row + rng.Column + rng.Rows.Count - 1
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If cll.Column + cll.Row = ddd Then Set newrng = Union(newrng, cll)
Next cll
newrng.Select
AC.Activate
End Sub
Sub blah7() 'bottom right
Set rng = Selection
Set AC = rng(rng.Rows.Count)
Set newrng = AC
ddd = rng.Row + rng.Column + rng.Rows.Count - 1
For Each cll In rng.Resize(, rng.Rows.Count - 1).Offset(, 1)
If cll.Column + cll.Row >= ddd Then Set newrng = Union(newrng, cll)
Next cll
newrng.Select
AC.Activate
End Sub
I haven't got time now to do this but they each have similar code so it shouldn't be too hard to consolidate them into a single sub to which you could pass arguments.

[mdmackillop]

Variations on a theme. You can easily fix which you need to select as the ActiveCell opn completion


Sub Tri1()
Dim x As Long, y As Long, z As Long
Dim rngTriang As Range
Dim Rng As Range
Selection.Columns(1).Select
Set Rng = ActiveCell
Set rngTriang = Rng
x = Selection.Cells.Count
For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, Rng.Offset(y).Resize(, z))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 1
Rng.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub Tri2()
Dim x As Long, y As Long, z As Long
Dim rngTriang As Range
Dim Rng As Range
Selection.Columns(1).Select
Set Rng = ActiveCell
Set rngTriang = Rng
x = Selection.Cells.Count
For z = 1 To x
Set rngTriang = Union(rngTriang, Rng.Offset(y).Resize(, z))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 22
Rng.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub Tri3()
Dim x As Long, y As Long, z As Long
Dim rngTriang As Range
Dim Rng As Range
Selection.Columns(1).Select
Set Rng = ActiveCell
Set rngTriang = Rng
x = Selection.Cells.Count
For z = 1 To x
Set rngTriang = Union(rngTriang, Rng.Offset(y, 1 - z).Resize(, z))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 3
Rng.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub Tri4()
Dim x As Long, y As Long, z As Long
Dim rngTriang As Range
Dim Rng As Range
Selection.Columns(1).Select
Set Rng = Selection(Selection.Cells.Count)
Set rngTriang = Rng
x = Selection.Cells.Count
For z = 1 To x
Set rngTriang = Union(rngTriang, Rng.Offset(y, 1 - z).Resize(, z))
y = y - 1
Next
rngTriang.Interior.ColorIndex = 4
Rng.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub Diag1()
Dim x As Long, y As Long, z As Long
Dim rngTriang As Range
Dim Rng As Range
Selection.Columns(1).Select
Set Rng = ActiveCell
Set rngTriang = Rng
x = Selection.Cells.Count
For z = 1 To x
Set rngTriang = Union(rngTriang, Rng.Offset(y, 1 - z))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 14
Rng.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub Diag2()
Dim x As Long, y As Long, z As Long
Dim rngTriang As Range
Dim Rng As Range
Selection.Columns(1).Select
Set Rng = ActiveCell
Set rngTriang = Rng
x = Selection.Cells.Count
For z = 1 To x
Set rngTriang = Union(rngTriang, Rng.Offset(y, z - 1))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 16
Rng.Activate
Set rngTriang = Nothing
End Sub

[xluser2007]

all of 'em:I haven't got time now to do this but they each have similar code so it shouldn't be too hard to consolidate them into a single sub to which you could pass arguments.
Thanks very much p45cal, I really appreciate your help and time on this one.

It is amazing to see the elegant coding you have used.

Just pasted yours in a test workbook, as attached.

Just with regard to my earlier post, a few queries:

When the user selects a block of contagious cells e.g. 3 rows * 4 cols, could the triangle be made to start from the first Column only?
If the user selects non-contagious cells e.g A1:A5, B1:B5, E10:E15, could the traingle be made to start from the first area i.e. A1:A5?
Later, if you have the time, I would love to understand how to consolidate the macros into a single code. I understand that you are busy and fully appreciate your help, but learning this would be a cool thing to know how to do.kind regards,

[mdmackillop]

Use this line from my code to get the first column

Selection.Columns(1).Select

[xluser2007]

Use this line from my code to get the first column

Selection.Columns(1).Select



Brilliant malcolm, that answers the contagious and non-contagious cells question!

[p45cal]

Just with regard to my earlier post, a few queries:In haste, I'm gone 'til Monday or Tuesday.

When the user selects a block of contagious cells e.g. 3 rows * 4 cols, could the triangle be made to start from the first Column only? Yes, start with Selection.columns(1).select. But with all this swine flu about I wouldn't want to be anywhere near these cells.:)

If the user selects non-contagious cells e.g A1:A5, B1:B5, E10:E15, could the traingle be made to start from the first area i.e. A1:A5?Possibly, with the likes of Selection.areas(1).select, but haven't time to test/refine.

Later, if you have the time, I would love to understand how to consolidate the macros into a single code. I understand that you are busy and fully appreciate your help, but learning this would be a cool thing to know how to do.I am away for a few days, but if where I'm going has an internet connection and... I'll give it a go.
ps contiguous

[mdmackillop]

Are you looking to exactly create the pattern shown in Post #9

[Aussiebear]

It was interestig to note that in testing the initial file uploaded by xluser2007, the following results occur

Single cell selection: p45cal's error out and all others just sit there.
3 vertical cell selection: All work as intended.

However if you select 3 horizontal cells: p45cal's errors out, Xld's retains the user highlighted format, Holger's code reverses the user highlighted format, and MD's functions as if 3 vertical cells were selected.

[mdmackillop]

... and MD's functions as if 3 vertical cells were selected.

Lateral thinking!!! :rotlaugh:

[Aussiebear]

Lateral???? what's that when you are upside down as in Australia?

[xluser2007]

In haste, I'm gone 'til Monday or Tuesday.
Yes, start with Selection.columns(1).select. But with all this swine flu about I wouldn't want to be anywhere near these cells.:)
Possibly, with the likes of Selection.areas(1).select, but haven't time to test/refine.
I am away for a few days, but if where I'm going has an internet connection and... I'll give it a go.
ps contiguous

LOL :rotlaugh:.

Sure thing p45cal. Again appreciate your help and insights. I reckon md's


Selection.Columns(1).Select

approach will solve the above queries.

In terms of consolidating the code, please take your time. I know you must be very busy.

Thanks and kind regards,

[xluser2007]

Are you looking to exactly create the pattern shown in Post #9

md, sorry I;m not sure I understand what you mean by this query. Could you please clarify.

[mdmackillop]

I would love to understand how to consolidate the macros into a single code.

If you need to select multiple shape areas, you could do this in one code. Otherwise, you need to call separate macros for each shape. I wondered whether your demo sheet was a Standard layout you used.

[xluser2007]

If you need to select multiple shape areas, you could do this in one code. Otherwise, you need to call separate macros for each shape. I wondered whether your demo sheet was a Standard layout you used.
Hi md,

At any one point, this macro should only select one shape area i.e. the bottom left traingle for example. The consolidation idea was basically to make a generic macro to select triangles and another generic macro to select diaginals, and then have 6 separate macros to call on that these 2 generic macros for the 6 types of selections.

The Demo sheet, just showed every single possible combination. The ideal outcome would be to create a docked commandbar with pictures of the triangles with the relavent code linked to it (that i was hoping to ask in another thread - once this is fully resolved). The user would click the relevant shape button to select that type of shape.

Does that clarify more malcolm? Please let me know if I am being unclear in any way.

thanks and kind regards

[mdmackillop]

Here's a simple userform incorporating p45cal's code. You can add images etc. as required.

[xluser2007]

Hi md,

You are a real trooper. Thank you for preparing this.

I have however, based on your approach a few changes that I would like to make.

1. From your code, I noticed that the code will not run if a single row is selected. I am thinking of adding an extended functionality whereby it will work if a single row is selected. For example, I have attached a picture where the user selects only one row and runs the "triangle bottom-right" select macro.

Please note that if the user selects a mutiple row block then the preeference should always go to the first column i.e.


Selection.Columns(1).Select
However, if the user selects a 1 row * m column array then the code should select a triangle as shown in the target output picture below. The code would be simlar for the other triangle tools. Note that when selecting a single rows of cells, then the bottom-left and bottom-right triangles selected would be on top of the row selected (as shown). Where as the top-left triangle and the top right-triangle would be below the row selected. As such this may require some error handling to ensure that the triangle selected does not exceed Excel's rows and column limits.

But I am confused as to how to do the above, as the code is a bit complicated.

Is it possible to extend the code to do this?

I hope this makes sense. Please let me know if I can clarify further.

[xluser2007]

Also, my second query is:

2. I would like to make this collection of macros more as a dockable toolbar rather than a userform. I have taken the liberty of making my target images for my ideal add-in. I am unsure as to how to make an add-in that loads these images with suitable error-handling. Could you please help me with this?

Al the images are created in the attached spreadsheet, I just need help compiling and attaching them to a toolbar and the relevant macros.

Please find attached the spreadsheet with the macros.

I found the following example by Ole Erlandsen to do this with custom images, but wasn't sure how to integrate it with the existing code:

http://www.erlandsendata.no/downloads/commandbaricons.zip

This is from the website:

http://www.erlandsendata.no/english/index.php?d=endownloadcommandbars (http://www.erlandsendata.no/english/index.php?d=endownloadcommandbars)

I really appreciate your great help md, if you could please help to solve these queries, this would be a brilliant addin indeed :).

[mdmackillop]

Here's my revised code (I follow it easier). I'll have a look at the buttons

Option Explicit
Dim x As Long, y As Long, z As Long
Dim rngTriang As Range, r As Range, cls As Long

Function Rng(Sel As Range, Direct As Long) As Range
x = 0: y = 0: z = 0
cls = Sel.Cells.Count
If Sel.Rows.Count > 1 Then
Set Rng = Sel.Columns(1)
Else
If Direct = -1 Then
Set Rng = Sel.Cells(1, 1).Offset(1 - cls).Resize(cls)
Else
Set Rng = Sel.Cells(1, 1).Resize(cls)
End If
End If
End Function
Sub TopLeft()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(y).Resize(, z))
rngTriang.Interior.ColorIndex = 6
y = y + 1
Next
rngTriang.Interior.ColorIndex = 1
r.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub BotLeft()
Set r = Rng(Selection, -1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = 1 To x
Set rngTriang = Union(rngTriang, r.Offset(y).Resize(, z))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 22
r.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub BotRight()
Set r = Rng(Selection, -1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r.Offset(x - 1)


For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(z - 1, y).Resize(, z))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 3
r.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub TopRight()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(y, x - z).Resize(, z))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 4
r.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub DiagBLTR()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r.Offset(, x - 1)

For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(y, z - 1))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 14
r.Offset(x - 1).Activate
Set rngTriang = Nothing
End Sub

Sub DiagTLBR()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = 1 To x
Set rngTriang = Union(rngTriang, r.Offset(y, z - 1))
y = y + 1
Next
rngTriang.Interior.ColorIndex = 16
r.Activate
Set rngTriang = Nothing
End Sub

[mdmackillop]

Try this

[xluser2007]

Try this
Hi md,

Just to reiterate, you are a very helpful and great coder!

I have installed and tested your code.I have a few changes/ queries that i wanted to run by you.

In terms of the actual code, the final output is supposed to be a selection tool and not highlighting. as such, I went through and changed your code as follows (in this case for the "TopLeft" macro):

From:

Sub TopLeft()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(y).Resize(, z))
rngTriang.Interior.ColorIndex = 6
y = y + 1
Next
rngTriang.Interior.ColorIndex = 1
r.Select
Set rngTriang = Nothing
End Sub
to:

Sub TopLeft()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(y).Resize(, z))
y = y + 1
Next

rngTriang.Select
r.Activate

Set rngTriang = Nothing

End Sub
Do you agree that these are th only changes I need to make with regards to making it a selection only tool?

2. For the Top Left macro, so as to make the activecell on the bottom left of the triangle what would I change the following lines to?

Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
3. I find that the addin-toolbar doesn't always load when I open and Close Excel. To make it work, I need to keep Going to Tools>Addins and then unchecking the Triangle Addin, and then re-checking it to make the toolbar appear. Is there a way to make the toolbar appear every time you open an instance of excel and then having it remain docked whilst the instance of Excel remains open?

4. In terms of error handling, I found that If I highlighted a single-row of cells, say H2:K2 and selected the bottom right triangle select macro, the macro threw a "Run-time error '1004' Application defined object error. Presumably, this is becasue it is trying to bulid a triangle of height 4, but can't actually select it, as there are not enough rows to go up. As such is there a way to ensure that the selections remain below Excel's row and column limits? In this example, the ideal output would be selecting the array fo cells {H2,I2,K2,I1,J1}.

5. In terms of more generic error handling, I thought it would be nice to have a check that there is actually something selected before ruunign the macro. and secondly that the object selected is in fact a range object. as such, I wrote the following code. Could you please let me know if it is
(a) Redundant in any way and;
(b) if it can be improved in any way and;
(c) How to most rigorously integrate it with all of the 6 macros?

Sub Check_Selection_is_Range()

If Not Selection Is Nothing Then

If UCase(TypeName(Selection)) <> "RANGE" Then

Call MsgBox("You have currently selected a ." _
& vbCrLf & "" _
& vbCrLf & "Please select a COLUMN or a ROW of CELLS and re-run to continue." _
, vbCritical, "This tool only works on Selected Cells!")

Else

' Do the relevant SELECTION macro here

End If

Else

Call MsgBox("Please select a COLUMN or a ROW of CELLS and re-run to continue.", _
vbExclamation, "This tool only works on Selected Cells!")


End If


End Sub
Sorry for the barrage of questions, but I figure you are the best person to ask these queries.

That's all I had for now based on the initial testing, sincerely appreciate your help on this md :).

Kind regards,

[mdmackillop]

Please post your suggestions for error checking code. I can look at these this evening for incorporation.

[Bob Phillips]

In terms of the actual code, the final output is supposed to be a selection tool and not highlighting. as such, I went through and changed your code as follows (in this case for the "TopLeft" macro):

From:

Sub TopLeft()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(y).Resize(, z))
rngTriang.Interior.ColorIndex = 6
y = y + 1
Next
rngTriang.Interior.ColorIndex = 1
r.Select
Set rngTriang = Nothing
End Sub
to:

Sub TopLeft()
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)
Set rngTriang = r

For z = x To 1 Step -1
Set rngTriang = Union(rngTriang, r.Offset(y).Resize(, z))
y = y + 1
Next

rngTriang.Select
r.Activate

Set rngTriang = Nothing

End Sub
Do you agree that these are th only changes I need to make with regards to making it a selection only tool?

You would need to make changes to all of the routine, BotLeft, BotRight, etc., as well.


2. For the Top Left macro, so as to make the activecell on the bottom left of the triangle what would I change the following lines to?

Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)

That should be


Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(x, 1)


3. I find that the addin-toolbar doesn't always load when I open and Close Excel. To make it work, I need to keep Going to Tools>Addins and then unchecking the Triangle Addin, and then re-checking it to make the toolbar appear. Is there a way to make the toolbar appear every time you open an instance of excel and then having it remain docked whilst the instance of Excel remains open?

Try moving the toolbar build code to Workbook_Open.


4. In terms of error handling, I found that If I highlighted a single-row of cells, say H2:K2 and selected the bottom right triangle select macro, the macro threw a "Run-time error '1004' Application defined object error. Presumably, this is becasue it is trying to bulid a triangle of height 4, but can't actually select it, as there are not enough rows to go up. As such is there a way to ensure that the selections remain below Excel's row and column limits? In this example, the ideal output would be selecting the array fo cells {H2,I2,K2,I1,J1}.


Function Rng(Sel As Range, Direct As Long) As Range
x = 0: y = 0: z = 0
cls = Sel.Cells.Count
If Sel.Rows.Count > 1 Then
Set Rng = Sel.Columns(1)
Else
If Direct = -1 Then
If Sel.Cells(1, 1).Row - cls < 1 Then cls = Sel.Cells(1, 1).Row
Set Rng = Sel.Cells(1, 1).Offset(1 - cls).Resize(cls)
Else
Set Rng = Sel.Cells(1, 1).Resize(cls)
End If
End If
End Function

[xluser2007]

Hi Bob, md,

Many thanks for your helpful replies.


You would need to make changes to all of the routine, BotLeft, BotRight, etc., as well.



Thanks, I have updated all the routines accordingly.



That should be


Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(x, 1)



Bob, I find that this doesn't quite work, as changing r (the active cell value that we want the selection to end up with as the Activecell) actually affects the Union Selection.

Is there an alternative way to do this, using say the "rngTriang" range?




Try moving the toolbar build code to Workbook_Open.



This sounds promising, as I believe you mean similar to johnske's ALZ creation Article here (http://vbaexpress.com/forum/showthread.php?t=10855). I can;t find the zip file though. I was hoping to just take johnske's generic Addin code and add in md's great modules to it. Have you got this file per chance, or any ideas how to integrate using his rigorous addin error-handling code?




Function Rng(Sel As Range, Direct As Long) As Range
x = 0: y = 0: z = 0
cls = Sel.Cells.Count
If Sel.Rows.Count > 1 Then
Set Rng = Sel.Columns(1)
Else
If Direct = -1 Then
If Sel.Cells(1, 1).Row - cls < 1 Then cls = Sel.Cells(1, 1).Row
Set Rng = Sel.Cells(1, 1).Offset(1 - cls).Resize(cls)
Else
Set Rng = Sel.Cells(1, 1).Resize(cls)
End If
End If
End Function
I just tested this. I find that it doesn;t throw any more errors, which is fantatstic. Minor point, but in the example I gave, it highlights {H2,I2,I1}, instead of {H2,I2,K2,I1,J1}. Not a major issue, but just wondering if it's possible to do the second option. Also, the code throws a similar error if you hit the rows down the bottom of the worksheet i.e. after row 65536 (unlikely that anyone would ever run it down there though :).

Also, sincerely sorry to bother, but the top-left routine for example throws a similar error if you exceed the column bounds (I only gave the row example). Is there any way to amend for this case?


Please post your suggestions for error checking code. I can look at these this evening for incorporation.
md, the only error handling that I could come up with was the "Check_Selection_is_Range" macro to ensure that a proper range is selected, which I was hoping to understand how to integrate with the 6 macros from you.

As such, Bob has almost answered the other error-handling queries regarding row/column limits and the active cell postion etc.

The only other thing pending is integrating with Johnske's Addin code.

Could you please assist with the above. this is helping heaps, not just for my work purpose, but learning how MVPs approach tool development.

Sincere thanks to both of you, I am learning lots, at least from a testing and debugging front.

kind regards,

[Bob Phillips]

Bob, I find that this doesn't quite work, as changing r (the active cell value that we want the selection to end up with as the Activecell) actually affects the Union Selection.

Is there an alternative way to do this, using say the "rngTriang" range?

This doesn't change the r range so it shouldn't affect the union, but just uses row x in the activate rather that row 1 as you had it.



This sounds promising, as I believe you mean similar to johnske's ALZ creation Article here (http://vbaexpress.com/forum/showthread.php?t=10855). I can;t find the zip file though. I was hoping to just take johnske's generic Addin code and add in md's great modules to it. Have you got this file per chance, or any ideas how to integrate using his rigorous addin error-handling code?

I am not sure and I don't think I have the patience to read all 11 pages of that article, but MD's addin was already fully functional, just making that change should ensure that the toolbar is always setup. The other changes re for the function changes that you require.

I am also not sure that you mean error handling, or at least error catching. It seems to me that you want it to behave differently if there is no room to behave normally, which is a different thing. In that case, it needs to be coded accordingly.


I just tested this. I find that it doesn;t throw any more errors, which is fantatstic. Minor point, but in the example I gave, it highlights {H2,I2,I1}, instead of {H2,I2,K2,I1,J1}. Not a major issue, but just wondering if it's possible to do the second option. Also, the code throws a similar error if you hit the rows down the bottom of the worksheet i.e. after row 65536 (unlikely that anyone would ever run it down there though :).

It is possible, but it would mean recutting MDs code as he works horizontally using a row count, and my code adjusted that count.

[Bob Phillips]

How about this?



Option Explicit

Public Enum TriangulateStyle
TopLeft = 1
TopRight = 2
BottomRight = 3
BottomLeft = 4
DiagonalBLTR = 5
DiagonalTLBT = 6
End Enum

Public Function TriangulateTL()
Dim rng As Range

Set rng = Selectiont
Call TriangulateNext(TopLeft, rng, rng.Cells.Count, 0)
rng.Select
rng.Cells(rng.Areas(1).Rows.Count, 1).Activate
End Function

Public Function TriangulateTR()
Dim rng As Range

Set rng = Selection
Call TriangulateNext(TopRight, rng, rng.Cells.Count, 0)
rng.Select
rng.Cells(rng.Areas(1).Rows.Count, 1).Activate
End Function

Public Function TriangulateBR()
Dim rng As Range

Set rng = Selection
Call TriangulateNext(BottomRight, rng, rng.Cells.Count, 0)
rng.Select
rng.Cells(rng.Areas(1).Rows.Count, 1).Activate
End Function

Public Function TriangulateBL()
Dim rng As Range

Set rng = Selection
Call TriangulateNext(BottomLeft, rng, rng.Cells.Count, 0)
rng.Select
rng.Cells(1, 1).Activate
End Function

Private Function TriangulateNext( _
ByRef Direction As TriangulateStyle, _
ByRef rng As Range, _
ByRef NumCells As Long, _
ByRef Addon As Long)

NumCells = NumCells - 1
Addon = Addon + 1
Select Case Direction

Case TopLeft
If NumCells > 0 And rng.Areas(1).Column + Addon <= Columns.Count Then

Set rng = Union(rng, rng.Areas(1).Offset(0, Addon).Resize(NumCells))
Call TriangulateNext(Direction, rng, NumCells, Addon)
End If

Case TopRight
If NumCells > 0 And rng.Areas(1).Row + Addon <= Rows.Count Then

Set rng = Union(rng, rng.Areas(1).Offset(Addon, Addon).Resize(, NumCells))
Call TriangulateNext(Direction, rng, NumCells, Addon)
End If

Case BottomRight
If NumCells > 0 And rng.Areas(1).Row > Addon Then

Set rng = Union(rng, rng.Areas(1).Offset(-Addon, Addon).Resize(, NumCells))
Call TriangulateNext(Direction, rng, NumCells, Addon)
End If

Case BottomLeft
If NumCells > 0 And rng.Areas(1).Column + Addon <= Columns.Count Then

Set rng = Union(rng, rng.Areas(1).Offset(Addon, Addon).Resize(NumCells))
Call TriangulateNext(Direction, rng, NumCells, Addon)
End If
End Select
End Function

[mdmackillop]

Very neat Bob, but problem with horizontal starting selections.

[Bob Phillips]

Very neat Bob, but problem with horizontal starting selections.

Can you clarify that please Malcolm?

[mdmackillop]

See post #27


However, if the user selects a 1 row * m column array then the code should select a triangle as shown in the target output picture below

[p45cal]

As promised, see attached which contains a new toolbar with your images on.
Addresses:
-single row selected
-checks it will fit on sheet
-made a guess at which cell is to be the active cell in each case
-consolidated single sub to handle all 6 cases
-a range not selected (say a chart instead) when macro started
-multiple areas selected (it chooses the first one (that was selected))
-single cell selected
-multi-row and multi-column block uses first column only

I leave you to create an add-in from it and to show/hide the toolbar as appropriate.

Code belowSub blahAll1(Rng, Slope, Filling)
'check selection is a range
If TypeName(Rng) = "Range" Then
Set Rng = Rng.Areas(1)
If Rng.Cells.Count > 1 Then
If Rng.Rows.Count = 1 Then
'check it's going to fit:
If Rng.Columns.Count <= Rng.Row Then
Set Rng = Rng.Cells(1).Resize(Rng.Columns.Count, 1).Offset(-Rng.Columns.Count + 1)
Else
MsgBox "Won't fit above selection - try again"
Exit Sub
End If
Else
Set Rng = Rng.Columns(1)
If Rng.Rows.Count > Columns.Count - Rng.Column + 1 Then
MsgBox "Won't fit to the right of selection - try again"
Exit Sub
End If
End If
'Now a valid starting range (rng) has been established:
TypeCombi = Slope & Filling
'question: which should be active cell in each case? - I've guessed:
Set ac = Rng.Cells(Rng.Cells.Count) '1T,-1B,1N,1B
Select Case TypeCombi
' Case "-1T", "-1N", "1T": Set newrng = Rng.Cells(1): Set ac = Rng.Cells(1) '-1T,-1N,1T
Case "-1T", "-1N": Set newrng = Rng.Cells(1): Set ac = Rng.Cells(1) '-1T,-1N,1T
Case Else: Set newrng = Rng.Cells(Rng.Rows.Count)
End Select
ddd = Rng.Row + Rng.Column + Rng.Rows.Count - IIf(TypeCombi = "1T", 0, 1)

For Each cll In Rng.Resize(, Rng.Rows.Count).Cells
Select Case Slope
Case -1
xxx = (cll.Column - Rng.Column + 1) / (cll.Row - Rng.Row + 1)
Select Case Filling
Case "B": If xxx <= 1 Then Set newrng = Union(newrng, cll) '-1B
Case "N": If xxx = 1 Then Set newrng = Union(newrng, cll) '-1N
Case "T": If xxx >= 1 Then Set newrng = Union(newrng, cll) '-1T
End Select
Case Else 'Slope 1
xxx = cll.Column + cll.Row
Select Case Filling
Case "B": If xxx >= ddd Then Set newrng = Union(newrng, cll) '1B
Case "N": If xxx = ddd Then Set newrng = Union(newrng, cll) '1N
Case "T": If xxx < ddd Then Set newrng = Union(newrng, cll) '1T
End Select
End Select
Next cll
newrng.Select
Set Rng = Nothing: Set newrng = Nothing
ac.Activate
End If
End If
End Sub
macros called by the toolbar buttons:Sub NegT()
blahAll1 Selection, -1, "T"
End Sub
Sub NegB()
blahAll1 Selection, -1, "B"
End Sub
Sub NegN()
blahAll1 Selection, -1, "N"
End Sub
Sub PosT()
blahAll1 Selection, 1, "T"
End Sub
Sub PosB()
blahAll1 Selection, 1, "B"
End Sub
Sub PosN()
blahAll1 Selection, 1, "N"
End Sub
Thinking around the "PosN", "1B" nomenclature:
Each triangle/diagonal can be defined by 2 arguments:
1. The slope of the diagonal; positive = 1 = bottom left up to top right, negative 1 = -1 = top left to bottom right.
2. The filling, one of three: Top, Bottom or None (T,B or N)

[xluser2007]

Hi Bob, many thanks for your kind interest in this problem.


This doesn't change the r range so it shouldn't affect the union, but just uses row x in the activate rather that row 1 as you had it.


I initially meant that the range "r" actually changes throughout the code. But I believe you meant defining the ac right up the top of the cdoe, where "r" is first defined, not at the bottom. As such, your method indeed will work. Please correct me if I misunderstood you.



I am not sure and I don't think I have the patience to read all 11 pages of that article, but MD's addin was already fully functional, just making that change should ensure that the toolbar is always setup. The other changes re for the function changes that you require.

I am also not sure that you mean error handling, or at least error catching. It seems to me that you want it to behave differently if there is no room to behave normally, which is a different thing. In that case, it needs to be coded accordingly.


Bob, md. I hope taht when I meant to use Johnske's Addin example that i did not come across that I had any issues with md's approach in anyway.

Bob, I wasn't sure what you had meant by:


Try moving the toolbar build code to Workbook_Open.
As such I searched around anf found that johnske had done it in his generic Add-in creation template. However adding in this code required all the other modules in that article (from what I could understand), and as such, I thought to ask you both for the article, so that I could amend it appropriately. Though it seems that the solution may be a quick addition to md's existing add-in event code.

Could you please assist with this code Bob?

Also Bob, thank you for your elegant code in post #28. I was wondering when I was going to see your solution with Enums :).

Based on some testing, I was wondering if it could be corrected for the following issues:

single row selected - as per Malcolm's reference to post #27, which malcolms code addresses.
checks it will fit on sheet
check that only a range is selected
multiple areas selected
multi-row and multi-column block uses first column onlyI always love reading your great code, I am keen to understand how it could be adapted for the above changes.

[xluser2007]

As promised, see attached which contains a new toolbar with your images on.
Addresses:
-single row selected
-checks it will fit on sheet
-made a guess at which cell is to be the active cell in each case
-consolidated single sub to handle all 6 cases
-a range not selected (say a chart instead) when macro started
-multiple areas selected (it chooses the first one (that was selected))
-single cell selected
-multi-row and multi-column block uses first column only

I leave you to create an add-in from it and to show/hide the toolbar as appropriate.


Hi p45cal, hope you've been well.

Thank you kindly for your fantastic coding - works beautifully and adresses all the main question based on a coupole of days of testing.

I only modified it alightly to display some additional error messages. Aside from that everything is great.

Also, it was a cool touch to make the row and columns the same height and width to make it easier to check that only half-square selections are made in the triangle macros :thumb.


BTW, what are ddd and xxx supposed to mean. I want to just rename them based on their meaning so that I can understand and make sense of the code.

I am not sure how to make the add-in the way that malcolm did it. I'll give it a go though based on his method in this thread.

[Bob Phillips]

Bob, md. I hope taht when I meant to use Johnske's Addin example that i did not come across that I had any issues with md's approach in anyway.

Not at all, I was just thinking that you maybe hadn't fully appreciated the full scope of Malcolm's work.


Bob, I wasn't sure what you had meant by:

This was because Malcolm was building it in the addin-install, I was just suggesting an alternative place.



Also Bob, thank you for your elegant code in post #28. I was wondering when I was going to see your solution with Enums :).

I think I rarely wite any serious code now that doesn't have enums :)


Based on some testing, I was wondering if it could be corrected for the following issues:

single row selected - as per Malcolm's reference to post #27, which malcolms code addresses.
checks it will fit on sheet
check that only a range is selected
multiple areas selected
multi-row and multi-column block uses first column onlyI always love reading your great code, I am keen to understand how it could be adapted for the above changes.

I think the code catered for some of this, but I will package it into an addin using Malcoms icons, and see how close I get. May take a while though.

[p45cal]

BTW, what are ddd and xxx supposed to mean. I want to just rename them based on their meaning so that I can understand and make sense of the code. ddd and xxx are variable names chosen without forethought.
The way this code works is based on a grid, like your school times table, but instead of a times tables it's an addition table and a division table:1501
You can see in the first one (the addition table) that there's a diagonal of 11s, all values to the left and above that diagonal are less than 11, all values above 11 are below and to the right. The value 11 is one more than the number of squares on a side. The ddd is, in this case, the 11.
In the division table, you can see a pattern of ones on the opposite diagonal. This doesn't need calculationg, it's always 1. So where the slope is -1, there's no need for a value for ddd.
xxx is the number in each square of the grids above, calculated but never actually placed in the cell. It is compared against ddd or 1 in the code.

A more useful name for each of these variables? Up to you!

[xluser2007]

Thanks p45cal for your gereat explanations, as always. The code makes much more sense to me now :friends:.

Also with regard to creating the addin, I have pasted md's addin code into a workbook with buttons and your code (only slightly modified as mentioned in my previous post).

Could yourself, Bob or md please help put the finalising touches on the addin creation code or settings in the attached workbook please e.g. the appropriate additions to the workbook event code, and any other settings that need to be toggled?

[xluser2007]

I think the code catered for some of this, but I will package it into an addin using Malcoms icons, and see how close I get. May take a while though.

Thanks Bob, fully appreciate that you are busy and appreciate your efforts in taching and helping me.

I continue to learn a great deal from this thread from your p45cal and malcolm :thumb.

[xluser2007]

Thanks p45cal for your gereat explanations, as always. The code makes much more sense to me now :friends:.

Also with regard to creating the addin, I have pasted md's addin code into a workbook with buttons and your code (only slightly modified as mentioned in my previous post).

Could yourself, Bob or md please help put the finalising touches on the addin creation code or settings in the attached workbook please e.g. the appropriate additions to the workbook event code, and any other settings that need to be toggled?



Hi Bob, md and p45cal,

Could you please, if you have the time, assis with creating an addin- from the attached workbook (with all code pasted in and also Buttons)?


The workbook is as attached in post #46.

Any help sincerely appreciated.

[xluser2007]

Hi All,

Could you please assist me in creating the addin code for the workbook in post #46.

Any help sincerely appreciated.

Kind regards,

[Bob Phillips]

There is no workbook in post #46.

[xluser2007]

There is no workbook in post #46.

Sorry Bob :), I meant post #45.

[Bob Phillips]

.

[xluser2007]

Bob,

Many thanks for helping me to complete the problem at hand.

For my understanding, may I confirm that the key changes you made were the following:

1. changing the Thisworkbook code from:


Private Sub Workbook_AddinInstall()
CreateCustomCommandBar
End Sub

Private Sub Workbook_AddinUninstall()
DeleteCustomCommandBar
End Sub


to:


Option Explicit

Private Sub Workbook_Open()
CreateCustomCommandBar
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteCustomCommandBar
End Sub

May I ask, why the second works and the first doesn't?

2. Saved it as an *.xla file?

Are there any other changes made.

Sincerely, I want to thank p45cal, md and yourself for your kidn help and persisntence in solving all the main issues in this thread :friends:.

I'll test it for a couple of days and let you know if I have any remaining queries.

[mdmackillop]

This first code is run when the add-in is installed, the second when the add-in is "opened" i.e. when you open Excel and the add-in is loaded.

If you wanted the add-in loaded for only specific workbooks, you could add WorkBook open events to those
eg

Private Sub Workbook_Open()
AddIns("Actuarial Triangle Selector").Installed = True
End Sub

using the Workbook_AddinInstall code in the Add-in.

Does that make sense?

[xluser2007]

This first code is run when the add-in is installed, the second when the add-in is "opened" i.e. when you open Excel and the add-in is loaded.

If you wanted the add-in loaded for only specific workbooks, you could add WorkBook open events to those
eg

Private Sub Workbook_Open()
AddIns("Actuarial Triangle Selector").Installed = True
End Sub
using the Workbook_AddinInstall code in the Add-in.

Does that make sense?
Hi md,

thanks for your response.

Does that mean that the aletrnative Thisworkbook code in the addin file could read as follows?:


Private Sub Workbook_Open()
AddIns("Actuarial Triangle Selector").Installed = True
End Sub

Private Sub Workbook_AddinInstall()
CreateCustomCommandBar
End Sub

Private Sub Workbook_AddinUninstall()
DeleteCustomCommandBar
End Sub

also, i have found a slight issue with the original code, when selecting non range objects and running the macros, anmely when slecting a chart and running the "TopLeft" Traingle Select macro, i get a 'Runtime Error - 13' Type mismatch. I thought that this was error handled in the code below:


Sub Triangle_Diagonal_Select(Rng As Excel.Range, Slope As Long, Filling As String)

Dim ac As Excel.Range
Dim newrng As Excel.Range
Dim cll As Excel.Range
Dim xxx As Double
Dim TypeCombi As String
Dim ddd As Long

If Not Selection Is Nothing Then

If UCase(TypeName(Rng)) <> "RANGE" Then

Call MsgBox("You have currently selected a " & UCase(TypeName(Rng)) _
& vbCrLf & "" _
& vbCrLf & "Please select a COLUMN or a ROW of CELLS and re-run to continue." _
, vbCritical, "This tool only works on Selected Cells!")

Else

Set Rng = Rng.Areas(1)

If Rng.Cells.Count > 1 Then

If Rng.Rows.Count = 1 Then

' CHECK it's going to fit:

If Rng.Columns.Count <= Rng.Row Then
Set Rng = Rng.Cells(1).Resize(Rng.Columns.Count, 1).Offset(-Rng.Columns.Count + 1)

Else

MsgBox "Won't fit above selection - try again"
Exit Sub

End If

Else

Set Rng = Rng.Columns(1)

If Rng.Rows.Count > Columns.Count - Rng.Column + 1 Then

MsgBox "Won't fit to the right of selection - try again"
Exit Sub

End If

End If

' Now a valid starting range (rng) has been established:
TypeCombi = Slope & Filling

' QUESTION: WHICH SHOULD BE ACTIVE CELL IN EACH CASE? - I'VE GUESSED:
Set ac = Rng.Cells(Rng.Cells.Count) '1T,-1B,1N,1B
Select Case TypeCombi

' Case "-1T", "-1N", "1T": Set newrng = Rng.Cells(1): Set ac = Rng.Cells(1) '-1T,-1N,1T
Case "-1T", "-1N": Set newrng = Rng.Cells(1): Set ac = Rng.Cells(1) '-1T,-1N,1T
Case Else: Set newrng = Rng.Cells(Rng.Rows.Count)

End Select

ddd = Rng.Row + Rng.Column + Rng.Rows.Count - IIf(TypeCombi = "1T", 0, 1)

For Each cll In Rng.Resize(, Rng.Rows.Count).Cells

Select Case Slope

Case -1
xxx = (cll.Column - Rng.Column + 1) / (cll.Row - Rng.Row + 1)
Select Case Filling
Case "B": If xxx <= 1 Then Set newrng = Union(newrng, cll) '-1B
Case "N": If xxx = 1 Then Set newrng = Union(newrng, cll) '-1N
Case "T": If xxx >= 1 Then Set newrng = Union(newrng, cll) '-1T
End Select

Case Else 'Slope 1

xxx = cll.Column + cll.Row

Select Case Filling
Case "B": If xxx >= ddd Then Set newrng = Union(newrng, cll) '1B
Case "N": If xxx = ddd Then Set newrng = Union(newrng, cll) '1N
Case "T": If xxx < ddd Then Set newrng = Union(newrng, cll) '1T
End Select

End Select

Next cll

newrng.Select

Set Rng = Nothing: Set newrng = Nothing
ac.Activate

End If

End If

Else

Call MsgBox("Please select a COLUMN or a ROW of CELLS and re-run to continue.", _
vbExclamation, "This tool only works on Selected Cells!")


End If

End Sub

Could you please explain why this error-handling is not working? I am guessing it is because we have Dimesnioned Rng as Excel.Range as part of the macro parameters, and if I select a Chart for example, I can't get to the error-handling code below, as it refuses to accpt a non-range selection before running the macro. Could you please explain how to correct for this?

any help appreciated.

[mdmackillop]

Does that mean that the aletrnative Thisworkbook code in the addin file could read as follows?:

No.
Say that you only used this code in a workbook based on a few Actuarial templates, Act1.xlt, Act2.xlt and so on. The Workbook Open code would go in the Template file, the Install code would be in the Add-In. In that way, the Add-In would be loaded only as required.

[Bob Phillips]

I think that you could but you should do



Private Sub Workbook_Open()
AddIns("Actuarial Triangle Selector").Installed = False
AddIns("Actuarial Triangle Selector").Installed = True
End Sub

Private Sub Workbook_AddinInstall()
CreateCustomCommandBar
End Sub

Private Sub Workbook_AddinUninstall()
DeleteCustomCommandBar
End Sub


to be sure.

But I have to ask why bother, what I gave you works.

[xluser2007]

No.
Say that you only used this code in a workbook based on a few Actuarial templates, Act1.xlt, Act2.xlt and so on. The Workbook Open code would go in the Template file, the Install code would be in the Add-In. In that way, the Add-In would be loaded only as required.

Private Sub Workbook_Open()
AddIns("Actuarial Triangle Selector").Installed = False
AddIns("Actuarial Triangle Selector").Installed = True
End Sub

Private Sub Workbook_AddinInstall()
CreateCustomCommandBar
End Sub

Private Sub Workbook_AddinUninstall()
DeleteCustomCommandBar
End Sub
Thanks md and Bob for clarifying.

my query was more for learning purposes to understand why Bob's change worked.

BTW, for my error handling issue, I realised that the only change was for me to Dim Rng as VARIANT (not Excel.Range), so that it could accept any Selection type and then move onto the custom error-handling for RANGES only. Do you guys agree with what I've done - is there a better way?

[mdmackillop]

Check that is is a valid range before passing it to the sub routine. Consider

MsgBox TypeName(Selection)

You can use this result to determine how the code proceeds.

[mdmackillop]

BTW, If anyone does not understand the concept of "Project Creep", I shall point them to this thread!!!

[Bob Phillips]

BTW, If anyone does not understand the concept of "Project Creep", I shall point them to this thread!!!

You mean a typical user :)

But in many ways MD, it is threads such as these that distinguish VBAX. You wouldn't see anything like tis in MrExcel, it would disappear it millions of threads asking how to count coloured cells :(

[xluser2007]

Check that is is a valid range before passing it to the sub routine. Consider

MsgBox TypeName(Selection)
You can use this result to determine how the code proceeds.
Md, that is actually what i did to solve the problem, except i did it in the immediate window.

I just wanted to get your opinion on whether I was doing my testing correctly :)!

[xluser2007]

BTW, If anyone does not understand the concept of "Project Creep", I shall point them to this thread!!!

md, I take your comment in jest and good spirit :).

I felt though, that I've tried to contribute where possible to the discussion, but the key brilliance of coding has been p45cal Bob and yourself, which I very much appreciate.

If I have asked many related questions, the purpose is two-fold, namely to learn new techniques and also develop a tool that would be useful in my day-to-day work.

I can;t tell you how many times in my line of work we have to look at data this way and how useful this tool already is - if that offers any consolation.

regards

[Bob Phillips]

md, I take your comment in jest and good spirit :).

I felt though, that I've tried to contribute where possible to the discussion, but the key brilliance of coding has been p45cal Bob and yourself, which I very much appreciate.

If I have asked many related questions, the purpose is two-fold, namely to learn new techniques and also develop a tool that would be useful in my day-to-day work.

I think that I have explained in my response that it is questions like yours that draw me to VBAX, so no apologies, keep 'em flowing!


I can;t tell you how many times in my line of work we have to look at data this way and how useful this tool already is - if that offers any consolation.

regards
:
Well, money is a better consolation :), but failing that, we'll just have to spank your cricket team :rotlaugh:

[xluser2007]

I think that I have explained in my response that it is questions like yours that draw me to VBAX, so no apologies, keep 'em flowing!


:
Well, money is a better consolation :), but failing that, we'll just have to spank your cricket team :rotlaugh:

I thank you for sharing the first response Bob. It's people like you, md, p45cal, GTO, mikerickson et al that keep me coming back here!

As for the second response...I have a a friendly pool with an office pom that we would have this series 2-1. Still can't discount the possibility in terms of matches to be played but in terms of the current English form we'll have to see :)...

[Bob Phillips]

Still can't discount the possibility in terms of matches to be played but in terms of the current English form we'll have to see :)...

Don't forget our weather, we can always call on that, and the long term forecast is no more sun this summer.

[xluser2007]

Don't forget our weather, we can always call on that, and the long term forecast is no more sun this summer.
How could i forget your greatest weapon :thumb (just kidding).

You are right though, if there's no rain then i have some shot at winning my friendly bet.

Also, could you please tell Freddy to take a day off...

[Bob Phillips]

Also, could you please tell Freddy to take a day off...

I think that will happen, his body is crippled.

[Aussiebear]

we'll just have to spank your cricket team :rotlaugh:


Gees I must have missed something...... which team was bowled out for 102?

[Bob Phillips]

Poms 2 Convicts 1 ................:rotlaugh: :devil2: :rotlaugh: :devil2: :p

[Aussiebear]

Do you know how much pain I'm in.......?

[Bob Phillips]

Do you know the joy here ....

[Aussiebear]

I suppose you'll be reminding me on the odd occasion for the next 18 months.

[mdmackillop]

18 months! We're still hearing about the World Cup win in 1966.