Lateral???? what's that when you are upside down as in Australia?
Lateral???? what's that when you are upside down as in Australia?
Remember To Do the Following....
Use [Code].... [/Code] tags when posting code to the thread.
Mark your thread as Solved if satisfied by using the Thread Tools options.
If posting the same issue to another forum please show the link
LOL .Originally Posted by p45cal
Sure thing p45cal. Again appreciate your help and insights. I reckon md's
approach will solve the above queries.Selection.Columns(1).Select
In terms of consolidating the code, please take your time. I know you must be very busy.
Thanks and kind regards,
md, sorry I;m not sure I understand what you mean by this query. Could you please clarify.Originally Posted by mdmackillop
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.I would love to understand how to consolidate the macros into a single code.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Hi md,Originally Posted by mdmackillop
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
Here's a simple userform incorporating p45cal's code. You can add images etc. as required.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
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.
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.Selection.Columns(1).Select
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.
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/download...ndbaricons.zip
This is from the website:
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 .
Here's my revised code (I follow it easier). I'll have a look at the buttons
[VBA]
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
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Try this
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Hi md,Originally Posted by mdmackillop
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:
[vba]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[/vba]
to:
[vba]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[/vba]
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?
[vba]
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(1, 1)[/vba]
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?
[vba]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[/vba]
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,
Last edited by xluser2007; 07-26-2009 at 11:53 PM.
Please post your suggestions for error checking code. I can look at these this evening for incorporation.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
You would need to make changes to all of the routine, BotLeft, BotRight, etc., as well.Originally Posted by xluser2007
That should beOriginally Posted by xluser2007
[vba]
Set r = Rng(Selection, 1)
x = r.Cells.Count
Set r = r.Cells(x, 1)[/vba]
Try moving the toolbar build code to Workbook_Open.Originally Posted by xluser2007
[vba]Originally Posted by xluser2007
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[/vba]
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Hi Bob, md,
Many thanks for your helpful replies.
Thanks, I have updated all the routines accordingly.Originally Posted by xld
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.Originally Posted by xld
Is there an alternative way to do this, using say the "rngTriang" range?
This sounds promising, as I believe you mean similar to johnske's ALZ creation Article here. 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?Originally Posted by xld
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 .Originally Posted by xld
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?
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.Originally Posted by mdmackillop
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,
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.Originally Posted by xluser2007
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.Originally Posted by xluser2007
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.
It is possible, but it would mean recutting MDs code as he works horizontally using a row count, and my code adjusted that count.Originally Posted by xluser2007
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
How about this?
[vba]
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
[/vba]
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Very neat Bob, but problem with horizontal starting selections.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Can you clarify that please Malcolm?Originally Posted by mdmackillop
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
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 below[vba]Sub 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
[/vba]macros called by the toolbar buttons:[vba]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
[/vba]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)
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.