Bulk Assigning Macros?

[dwool40]

I have a row of buttons assigned to sequential macros, e.g,, M1, M2, M3, etc.

I need to add a few hundred of these. Is there an easier way to assign the macros other than right clicking each one individually?

Thanks!

 

[petertenthije]

Would it not be easier to work with tickboxes, and one macro to add all rows where the tickbox is marked?

 

[dwool40]

Here’s a couple of options to consider. Both are worksheet event modules – to add them, right-click on the Tab name of the “Notice” sheet, select View Code, then copy the code to the window that appears on the right of the screen. Save the file & test.

The first is a Worksheet_BeforeDoubleClick. It is aimed at the F column (F2:F750 to be exact). Whenever you double click on any cell in that range, the value in that cell is copied to the next available empty cell in column A on the “Board” sheet. I’ve left an option in there (uncomment the line to activate) to convert the value in the cell to “OK” as well to signify that it’s been copied across. One macro, and no buttons required at all.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Escape
    Application.EnableEvents = False
   
    If Not Intersect(Range("F2:F750"), Target) Is Nothing Then
        Cancel = True
        With Target.Cells
            .Copy
            Worksheets("Board").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            'UNCOMMENT THIS NEXT LINE if you want the cell value in column F change to "OK" automatically
            '.Value2 = "OK"
        End With
    End If
   
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

The second is a Worksheet_SelectionChange. This one is aimed at column H (if you’re still wedded to having something there to “press”). Instead of hundreds of buttons though, simply add some text/formatting to the cells for effect (see below). Whenever a cell is selected, the value in column F of that row is copied to the next available empty cell in column A on the “Board” sheet. I’ve left an option in there (uncomment the line to activate) to convert the value in the cell to “OK” as well to signify that it’s been copied across. One macro, and no buttons required at all.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Escape
    Application.EnableEvents = False
   
    If Target.Cells.CountLarge = 1 And Not Intersect(Range("H2:H750"), Target) Is Nothing Then
        With Target.Cells.Offset(, -2)
            .Copy
            Worksheets("Board").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            'UNCOMMENT THIS NEXT LINE if you want the cell value in column F change to "OK" automatically
            '.Value2 = "OK"
        End With
    End If

Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

dwool40.xlsm
	F	G	H
2	OK		ADD
3	OK		ADD
4	7308-11S		ADD
5	7309-10H		ADD
6	7308-11S		ADD
7	OK		ADD
8	OK		ADD
Notice

Both of these work great! However, I forgot to mention that Column A on sheet Board is in a table. The data is being populated in A751 below the table.

 

[Norie]

What type of buttons are they Form or ActiveX?

If they are Form buttons then you could use one macro, assign it to all the buttons and then use Application.Caller to get the button name then extract the row.

Sub AddU()
Dim rw As Long

    rw = Mid(Application.Caller, 2)
    Sheets("Notice").Range("F" & rw).Copy
    Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues

End Sub

To use the above you would need to make sure the buttons were named consistently, ie AddU2 for row 2, AddU2 for row 3 etc.

If the buttons aren't name consistently you could still use this approach but it would need a bit more work - you would need to use the Shapes collection
to get a reference to the button that invoked the code and the use it's TopLeftCell property to get the row.

That approach would also rely on consistency but this time it would mean having the buttons placed consistently in the rows.

 

[kevin9999]

Both of these work great! However, I forgot to mention that Column A on sheet Board is in a table. The data is being populated in A751 below the table.

Assuming your previously posted method of getting the last row worked (i.e. xlDown) then try changing this line:

Worksheets("Board").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues

to this:

Worksheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial xlPasteValues

and see if that fixes it.
Incidentally, is there any reason why you don't want to copy all the relevant values in one step?

 

[dwool40]

This worked! I need them to address each addition before moving to the next. If they add all at once, something will get missed.

 

[dwool40]

Assuming your previously posted method of getting the last row worked (i.e. xlDown) then try changing this line:

Worksheets("Board").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues

to this:

Worksheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial xlPasteValues

and see if that fixes it.
Incidentally, is there any reason why you don't want to copy all the relevant values in one step?

I am making a separate post for something similar on the same sheet. However, this is row specific. Thank you for your help with this!

 

[kevin9999]

I am making a separate post for something similar on the same sheet. However, this is row specific. Thank you for your help with this!

Happy to help, and thanks for the feedback