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!

 

[kevin9999]

What do the macros do? Could you post the code?

 

[dwool40]

What do the macros do? Could you post the code?

There are a total of 750

Sub AddU2()
Sheets("Notice").Range("F2").Copy
Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues
End Sub
Sub AddU3()
Sheets("Notice").Range("F3").Copy
Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues
End Sub
Sub AddU4()
Sheets("Notice").Range("F4").Copy
Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues
End Sub

 

[kevin9999]

Thanks for that. Can I ask, is the AddU2 button in row 2, AddU3 in row 3 etc?

 

[dwool40]

Thanks for that. Can I ask, is the AddU2 button in row 2, AddU3 in row 3 etc?

Yes, it is.

 

[kevin9999]

I'm away from my regular laptop at the moment, but I'm thinking of a different approach. Instead of using hundreds of buttons (and macros) I personally would use either a worksheet selection change, or a double click event code which would run via a single macro. Leave it with me for a while.

 

[dwool40]

I'm away from my regular laptop at the moment, but I'm thinking of a different approach. Instead of using hundreds of buttons (and macros) I personally would use either a worksheet selection change, or a double click event code which would run via a single macro. Leave it with me for a

 

[dwool40]

Each button adds the data from Column F to the bottom of Column A on the Board sheet. The data is variable with each import and can be in any row (2-750). Conditional formatting is used to highlight the new data to be added with "OK" for existing data that is already on the main sheet.

 

[kevin9999]

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

 

[dmt32]

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?

Whilst I suspect that you probably could just run a bit of code that copies all new data without need for pressing a button each time, you can, using your approach, add required buttons programmatically that call a common code which passes the Row as an argument.

Make backup of your workbbook & place both codes in a STANDARD module

Sub AddButtons()
    Dim btn         As Button
    Dim rng         As Range
    Dim r             As Long
    
    Const NoButtons As Long = 750
    
    With ActiveSheet
        If .Buttons.Count > 0 Then .Buttons.Delete
        For r = 2 To NoButtons
            Set rng = .Cells(r, "H")
            'add buttons for new data only
            If UCase(rng.Offset(, -2).Value) <> "OK" Then
            Set btn = .Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
            With btn
                .Caption = "Add"
                'pass row argument
                .OnAction = "'AddData " & r & "'"
            End With
            End If
        Next r
    End With
End Sub

Sub AddData(ByVal lngRow As Long)
  Dim objButton As Button
  Set objButton = ActiveSheet.Buttons(ActiveSheet.Buttons(Application.Caller).Index)
  'copy data
  Worksheets("Notice").Cells(lngRow, "F").Copy
  Worksheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=xlPasteValues
  'delete button
   objButton.Delete
End Sub

Assuming the required sheet is the Activesheet, Run the AddButtons code as required. You can specify how many buttons are added by changing the Constant (shown in bold) NoButtons value as required

The code should only create buttons for new data & when pressed & copy action completed, the button is deleted.



Hope Helpful



Dave