Insert row based on location of an image, not the highlighted cell

[AGibson73]

Hi all,

I was hoping someone might be able to assist with the following as I am a bit of an Excel macro novice.

I am trying to create a spreadsheet where users fill out the details in grey to create a budget. I have protected the sheet so users can only edit the cells in grey.

To make this spreadsheet as user friendly as possible, I have added 2 images in column G and assigned macros to them so users can copy or delete that row.

So when I click on the copy image in row 11, the macro copies the details into an inserted row below and the user then edits as required.

Then if I click the copy image in row 12, this copies those details into row 13 and the process continues.

The issue though is the row copy seems based on where the selected cell is, and nothing to do with the row the button is clicked on.

So in the screenshot below, I click on the copy image in row 12 but as the highlighted cell was B11, it copies those details from row 11 down (which would throw people a little).

Likewise (and more worryingly) for the delete button, if I wanted to delete row 13 but the highlighted cell was in row 12, the user unwittingly deletes the wrong person.

So what I think I need is for the macro to detect the row of the clicked image, and then set the focus to highlight a cell on that row, but I am having no joy in working out how.

My macros are as below:

Sub AddRowPersonnel()

'Take worksheet out of protected mode

ActiveSheet.Unprotect

'Select the existing row and copy it

ActiveCell.Rows("1:1").EntireRow.Select

Selection.Copy

'Move cursor down one row, insert new row, and then paste values into the new row

ActiveCell.Offset(1, 0).Range("A1").Select

Application.CutCopyMode = False

Selection.EntireRow.INSERT

ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select

Selection.Copy

ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select

ActiveSheet.Paste

'Put worksheet back into protected mode

ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub



Sub DeleteRowPersonnel()

‘ Unprotect worksheet

ActiveSheet.Unprotect

‘ Highlight selected row and delete it

ActiveCell.Rows("1:1").EntireRow.Select

Selection.Delete Shift:=xlUp

‘Put worksheet back into protected mode

ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Many thanks in advance!

 

[jasonb75]

See if this works for deleting rows

Sub DeleteRowPersonnel()
With ActiveSheet
    .Unprotect
    .Shapes(Application.Caller).TopLeftCell.EntireRow.Delete
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

If it does as expected then a similar method can be applied to the copy section as well.

 

[AGibson73]

Yes - wow this works a treat so many thanks!
I've had a crack at applying this approach to the copy section but my attempt below probably shows how rudimentary my current skills are.

Are you able to fill in this part of the puzzle for me? I'm going to take a few VBE and VBA tutorials after this so I can better understand and help myself/others in this space.

    ActiveSheet.Unprotect
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.EntireRow.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    Application.CutCopyMode = False
    Selection.EntireRow.INSERT
    ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    ActiveSheet.Paste
    ActiveSheet.protect DrawingObjects:=True, Contents:=True, Scenarios:=True

 

[jasonb75]

Hopefully this one will work as well, but my luck is not usually that good on code that I haven't tested first.

Sub AddRowPersonnel()
With ActiveSheet
    .Unprotect
     With Intersect(.Shapes(Application.Caller).TopLeftCell.EntireRow, .UsedRange)
        .Copy
        .Offset(1).Insert shift:=xlDown
    End With
    Application.CutCopyMode = False
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

A good way to learn some basics is to clean up code that you create with the macro recorder (it records a lot of superfluous actions, selection, scrolling, etc).

One thing to note when you start writing your own code, you don't need to select anything. Selection slows your code down but other than that it serves no purpose (except at the end of your code if you want the cursor to be left in a specific place when control is returned to the user).

The example below shows how to copy a small range with and without selection, you can do exactly the same for anything that needs selection.

Sheets("Sheet1").Select
Range("A1:B10").Select
Selection.Copy

Sheets("Sheet1").Range("A1:B10").Copy

To carry out multiple tasks on the same range or sheet, you can use 'With' as I have done in your add and delete procedures. If you do this then you need to add a dot in front of any range commands, .Copy, .Paste, etc otherwise the code will run on the active sheet instead of the one that you specified.

 

[AGibson73]

Thanks again. All works perfectly - and especially thanks for your prompt response

 

[AGibson73]

Hi all,
I have a follow up question on this thread.

My macro uses the following code, but as it turns out for some reason get an error message. I can't determine the trigger for it as it seems to occur randomly. Any thoughts would be appreciated.

CODE:
Sub AddRow()
With ActiveSheet
.Unprotect
With Intersect(.Shapes(Application.Caller).TopLeftCell.EntireRow, .UsedRange)
.Copy
.Offset(1).Insert Shift:=xlDown
End With
Application.CutCopyMode = False
.protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With

End Sub

ERROR MESSAGE
Run-time error '-21474178-48 (80010108)':
Method 'Insert' of object "Range' failed