• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Shape to Insert Line and Add Unique ID Number

G

gumbles

New Member
Hi there,


I am trying to create a peice of code that is generic for all shapes on a particular worksheet, so any shapes on the worksheet will use it when clicked.


There is a list of headings and a shape is overlayed on each heading. WHen the user clicks on the shape it goes one row down from where the shape was selected and inserts a new row in the table. Then moves one cell to the right and inserts an ID number that is unique for the column.


Headings are in A:A

#ID number in B:B


Any Help is greatly appreciated!


Regards,


Gumbles
 
I have this which helps identify the cells address. Not sure if it can be made generic to any shape though.


Worksheets("Sheet Name").Shapes("Rectangle 1").TopLeftCell.Address


Still trying.


Gumbles
 
Hi Gumbles ,


Try this code to get the address of the cell in which the clicked shape is located :

[pre]
Code: 
Sub Shape_Click()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
MsgBox shp.TopLeftCell.Address
End Sub
[/pre]
Assign the same code to all the shapes.


Narayan
 
Hello Narayan,


Thankyou once again for helping me!


Im currently trying to piece togethe all the bits of code I have to perform the required task and this has helped hugely as im working it out through recorded macros lol.


Cheers,


Gumbles.
 
Ok So i have used your code and tried to bend it to my will.


This is what I have:

Sub insert_row()

Ro = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(1, 0).Row

Rows(Ro).Insert Shift:=xlShiftUp

Rows(Ro).Hidden = False

End Sub


but this inserts a row to the whole worksheet. When i record the action I get this:


Selection.ListObject.ListRows.Add (15)


Any ideas how to combine these?


Regards,


Gumbles
 
Hi Gumbles ,


I am sorry but I have not understood your exact requirement ; can you explain ?


The macro you have posted inserts one row under the shape that you click on ; is this OK or do you want something else to happen ?


Narayan
 
Hi Narayan,


It does work but not completely, The 1st bit of formula inserts a row but it's an entire row (accross the whole worksheet), I only need a row in the table. As there is other information to the left of the table.


I hope this is clearer.


Gumbles.
 
Hi Gumbles ,


Can you change the statement which does the insertion to the following :


Rows(Ro).Cells(1, 1).Resize(1, 5).Insert Shift:=xlShiftDown


Change the number 5 to the number of columns in your table.


Change the Cells(1,1) to whatever cell you wish to start from ; Cells(1,1) will start from the the first cell in that row i.e. from column A ; if you wish to start from column D , you will have to use Cells(1,4).


The above statement will shift all the cells from column A through E downwards ; I have changed the direction from xlShiftUp to xlShiftDown , since if your first shape is in row 1 , you cannot shift up ; I don't think you will have any shapes in row 1048576 !


Narayan
 
Narayan,


That code doesnt seem to be working in my table. I get a debug error.


Is it possible that because it in a table it needs to be selected as one? so perhaps the code needs to contain: ListObject.ListRows?


and thanks for the help.


Gumbles
 
Hi Gumbles ,


My mistake. Can you try this ?

[pre]
Code: 
Sub insert_row()
Dim Ro As Long
With ActiveSheet
Ro = .Shapes(Application.Caller).TopLeftCell.Row
.Cells(1, 1).Offset(Ro).Select
With ActiveCell
.ListObject.ListRows.Add (Ro)
.Offset(Ro).EntireRow.Hidden = False
End With
End With
End Sub
[/pre]
Narayan
 
Narayan,


Im getting a debug error on this line:


.ListObject.ListRows.Add (Ro)


I might be very wrong here, but when I was playing with the code before i could never get the fucntion "Activecell" to work. Not sure if this might mean something to you.


Really appreciated!


Gumbles
 
Hi Gumbles ,


I tried out the code with an actual table , before posting it ; can you upload your workbook , with just the table structure ? You can erase all the data , if you want ; just leave the table structure and the objects in it.


Narayan
 
Narayan,


Ill upload a version when I get home as I cannot access dropbox or speedyshare from work, the buggers.


Just as a quick check:


My Table is A3:K33


Shapes are in A3:A33

ID number = B3:B33


Regards,


Gumbles
 
Hi Gumbles ,


I assume that every cell A3 through A33 has a shape in it ?


Do you get an error on the shape in cell A3 , or do you get it when you click on some in-between shape ?


What you can do is place your cursor on the following statement in the code , and press F9 :


Ro = .Shapes(Application.Caller).TopLeftCell.Row


Now , when you click on any shape in the worksheet , the execution should break at the above statement ; thereafter , you can press F8 to step through the code , one statement at a time. In the Immediate Window , you can inspect variables or even execute statements ; so when the execution halts at the above statement , one press of the F8 key will execute the statement and halt at the next statement in the code ; in the Immediate Window , you can type in :


?Ro


to display the value of Ro ; it should display the row number of the shape you clicked on. See whether this is correct.


Another press of F8 will execute the next statement , which is selecting the appropriate cell ; you can now go to the worksheet and see if the correct cell has been selected ; this will be the Activecell for the next statement.


Narayan
 
Apologies for the delay,


This is the basic layout of my table.


https://www.dropbox.com/s/377v67ncock1m9p/Issue_List.xlsx


Also i have been trying your method of using f9 and going through the code with f8 and the error is always on the "selection.listobject.listrow.add()" line.


Gumbles.
 
Hi Narayan,


Apologies as I must have uploaded an older version. But the layout is exactly the same.

The shapes are overlayed on the questions in column A:A (using snap to grid) and made invisible so i must have overlooked this when uploading the wrong version.(DOH!)


The code on my current version is this:


Sub insert_row()


'Finds the highest number in the range "ID_RANGE"

ID = Application.WorksheetFunction.Max(Range("ID_RANGE"))


'Stops the screen refreshing during the macro

'Application.ScreenUpdating = False

'Application.Interactive = False


'Finds where the shape is located and inserts a row below

Ro = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(1, 0).Row

Rows(Ro).Insert Shift:=xlShiftUp

Rows(Ro).Hidden = False


'+ 1 to the max ID

Cells(Ro, 2) = ID + 1


'refreshes the screen

Application.ScreenUpdating = True

Application.Interactive = True


End Sub


This works but inserts an entire row, not just in the table.


Sorry for not having my head screwed on when I uploaded my example. but hopefully you can get an idea for the layout.


Gumbles
 
Hi ,


Can you check this file ? I am not getting any error when running the code.


http://speedy.sh/TMP3S/Gumbles-Issue-List.xlsm


Narayan
 
Hi Narayan,


Sorry but could you upload the file again as it doesn't seem to want to download. Ive been trying over the weekend but with no luck.


Thanks,


Gumbles.
 
You must log in or register to reply here.
Back
Top