Excel VBA - Creating shapes based on an adjacent Column

xKidz

New Member
Joined
Apr 12, 2019
Messages
16
Hi,


I have the below code, which adds buttons(shapes) to every cell from range A2:A200.
I would like this to be more dynamic, thus the desired result will be for this to add buttons based on an adjacent column, let's say Column B.
So if column B has data until line 40 i would like to have on Column A 40 buttons.

Code below:

```

'The Line Break Buttons (Break)




Sub breakButton()


Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Application.ScreenUpdating = False
Range("A2:A200").Select
Dim btn As Button
Dim t As Range
' Find the First & Last Row number of selection
Dim x As Long, y As Long
x = Selection.Rows(1).Row
y = Selection.Rows.Count + x - 1


For i = x To y ' Loop from first row to last row
Set t = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "btn_Click1"
.Caption = "Break " & i
.Name = "Break " & i
End With'
Next i
Application.ScreenUpdating = True




End Sub


```


As an extra question, just for me not to post another thread.

I would like that when i click the button (The one assigned to .OnAction in the formula) to copy cells a b c from the active cell, below.
Basically what i am trying to do is add more buttons below whenever i add new raw data to my spreadsheet.

I have tried this... I can copy the cell contents, just don't know how to paste them on the cell below. Did try an offset function but it doesn't seem to work on this type of function

```

Sub btn_Click1()






'Intersect(ActiveSheet.Shapes(Application.Caller).TopLeftCell.EntireRow, Range("D:V")).Insert xlShiftDown
'Intersect(ActiveSheet.Shapes(Application.Caller).TopLeftCell.EntireRow, Range("D:V")).Clear
Intersect(ActiveSheet.Shapes(Application.Caller).TopLeftCell.EntireRow, Range("D:V")).Copy


End Sub

```
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
I'm not a big advocate of putting hundreds of buttons on a sheet.

Do you realize a script can be run by just double clicking on a cell?

Running a script by just double clicking a cell eliminates needing hundreds of buttons.

What exactly do you want to happen when you click on of these buttons

Would not double clicking on a cell in column A do the job for you?

Try this script for example double click on any cell in column A and the script runs:

This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window


Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Modified  5/14/2019  11:31:54 AM  EDT
If Target.Column = 1 Then
Cancel = True
Target.Interior.ColorIndex = 4
With Target.Offset(, 1)
.Value = "See what i can do. And I can do most anything"
.Interior.ColorIndex = 3
.Font.Size = 16
.Columns.AutoFit
End With
MsgBox "Hello " & Application.UserName
End If
End Sub
 
Upvote 0
Hi,

Yes i think you are right. I am already spotting performance issues.

I just left work.
I will try it tommorow morning and let you know how i get on with this.

Many thanx
 
Upvote 0
Hi,

Love this.
So what i would like to do now is.
I would probably apply some text in columns A B C
I would like to double click any cell from Column A and color Cells D - V in red
I would like to double click any cell from Column B and color Cells D - V in yellow
I would like to double click any cell from Column C and insert a new row

Optional:

1)Can i somehow add this to my macro and automatically apply it to the sheet? I would like to run just a macro , the usual way and get it done.
2)What would be great but this could be a hard one, i would like to have this event script only where Column C is not blank
And it would be great that once i input some text in column C to automatically add the "events" on col A B C, though i think is impossible with the way macros work but i don't know much about event scripts so i am asking this.
Though i wouldn't mind if i would create a 4th column with ("event") add new column for example, which will insert a new row with just the event scripts A B C D.


Your help is much appreciated
 
Upvote 0
Hi,

Love this.
So what i would like to do now is.
I would probably apply some text in columns A B C
I would like to double click any cell from Column A and color Cells D - V in red
I would like to double click any cell from Column B and color Cells D - V in yellow
I would like to double click any cell from Column C and insert a new row

Optional:

1)Can i somehow add this to my macro and automatically apply it to the sheet? I would like to run just a macro , the usual way and get it done.
2)What would be great but this could be a hard one, i would like to have this event script only where Column C is not blank
And it would be great that once i input some text in column C to automatically add the "events" on col A B C, though i think is impossible with the way macros work but i don't know much about event scripts so i am asking this.
Though i wouldn't mind if i would create a 4th column with ("event") add new column for example, which will insert a new row with just the event scripts A B C D.


Your help is much appreciated


So i have actually managed to get them done aside from the optional questions.
 
Upvote 0
I'm not sure what you need. I showed you a example and you said you added a whole lot more and have it working but now your saying you want to add this to your current macro and just get it done.

You will have to explain more to me.

I do not know what you now have and what you want added.

A sheet event script cannot be added to a Module script and all work together.

Why would you want to do things the way you wanted with hundred of buttons and also at same time do it with my suggested way.

Or are you saying you have other scripts you want to run on the same sheet and want your double click script to also work on its own.

I will need to see all the scripts you want on the same sheet.
 
Upvote 0
Hi,

Yes, sorry for not being clear.
I am happy with what i have got at the moment for the event that replaced the buttons, works like a charm thanks for that.
Only thing now for me would be...
I have function RunAll in my Macro, which runs multiple functions.
Would it be possible to add this private one in there? so when i run the whole macro, this code will be added to the worksheet as well?

https://imgur.com/cC0RX0S
 
Last edited:
Upvote 0
I see your image and your three calls.

But how do these macros get activated
Do you want all three of these Macros to run every time you double click a cell

And from just looking at this image I have no ideal what any of these scripts do.
 
Upvote 0
It's hard for me to help you when your not showing me your scripts.
Just seeing a image with:
Call One
Call Two

Does not help me
 
Upvote 0

Forum statistics

Threads
1,223,276
Messages
6,171,140
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top