Replace Macro Buttons?

D

dwool40

New Member
Joined
Apr 27, 2018
Messages
46
Office Version
  1. 365
Platform
  1. Windows
I have sheet Notice that tells me when to ADD or remove DATA from sheet Board. To ADD, I am using:

VBA Code: 
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
            Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=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 C

This had allowed me to replace 750 buttons assigned to individual macros and only highlights and shows ADD when there is new data.
Add1.jpg



I am also using 750 buttons assigned to individual macros to REMOVE data using:

VBA Code: 
Sub Clearcells2()
Sheets("Board (2)").Range("A2:AA2").Copy Destination:=Sheets("Board").Range("A2")
End Sub

This allows me to remove the existing data (from Board) and repopulate formulas (from Board (2)). I would like to replace all these buttons with a single macro however each button is row specific.
Remove.jpg


The ADD is adding from the active sheet but the REMOVE is copying from one sheet to another. Is there a way to use something like the ADD in place of 750 REMOVE buttons?
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
This is my first try at this, I think it needs some clean up. I wanted to show what's possible before perfecting it. You'll need to give some more information. Let me know If I'm off base.

This needs to be pasted on the sheet where you have the cells with ADD and REMOVE. I assumed that Column C is where those cells are. If the user double clicks a cell in column C with ADD ore REMOVE in the cell, this will run and call one of the other two macros
VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim i As Range
  
  Set i = Intersect(Target, Range("C:C"))
  If Not i Is Nothing Then
    If i.Value = "ADD" Then
      Call AddCells(i)
    ElseIf i.Value = "REMOVE" Then
      Call ClearCells(i)
    End If
    Exit Sub
  End If
  
      
End Sub

This code gets pasted in a standard module. I altered the code a little to accept the Target range from the double click
VBA Code: 
Sub AddCells(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
            Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=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 C

End Sub

Sub ClearCells(Target As Range)
  Dim Rw As Long
  Dim Sht As Worksheet
  Dim Sht2 As Worksheet
  
  Set Sht = Sheets("Board (2)")
  Set Sht2 = Sheets("Board")
  Rw = Target.Row
  
  Sht.Range(Sht.Cells(Rw, 1), Sht.Cells(Rw, 27)).Copy Sht2.Cells(Rw, 1)

End Sub
 
Upvote 0
Jeffrey Mahoney said:
This is my first try at this, I think it needs some clean up. I wanted to show what's possible before perfecting it. You'll need to give some more information. Let me know If I'm off base.

This needs to be pasted on the sheet where you have the cells with ADD and REMOVE. I assumed that Column C is where those cells are. If the user double clicks a cell in column C with ADD ore REMOVE in the cell, this will run and call one of the other two macros
VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim i As Range
 
  Set i = Intersect(Target, Range("C:C"))
  If Not i Is Nothing Then
    If i.Value = "ADD" Then
      Call AddCells(i)
    ElseIf i.Value = "REMOVE" Then
      Call ClearCells(i)
    End If
    Exit Sub
  End If
 
     
End Sub

This code gets pasted in a standard module. I altered the code a little to accept the Target range from the double click
VBA Code: 
Sub AddCells(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
            Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=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 C

End Sub

Sub ClearCells(Target As Range)
  Dim Rw As Long
  Dim Sht As Worksheet
  Dim Sht2 As Worksheet
 
  Set Sht = Sheets("Board (2)")
  Set Sht2 = Sheets("Board")
  Rw = Target.Row
 
  Sht.Range(Sht.Cells(Rw, 1), Sht.Cells(Rw, 27)).Copy Sht2.Cells(Rw, 1)

End Sub
Click to expand...

ADD is column H and REMOVE is in column K.
 
Upvote 0
This code would be changed

VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim i As Range
  
  Set i = Intersect(Target, Range("H:H"))
  If Not i Is Nothing Then
    If i.Value = "ADD" Then
      Call AddCells(i)
    End If
    
    Exit Sub
  End If
  
  Set i = Intersect(Target, Range("K:K"))
  If Not i Is Nothing Then
    If i.Value = "REMOVE" Then
      Call ClearCells(i)
    End If
    Exit Sub
  End If
      
End Sub
 
Upvote 0
Jeffrey Mahoney said:
This code would be changed

VBA Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim i As Range
 
  Set i = Intersect(Target, Range("H:H"))
  If Not i Is Nothing Then
    If i.Value = "ADD" Then
      Call AddCells(i)
    End If
   
    Exit Sub
  End If
 
  Set i = Intersect(Target, Range("K:K"))
  If Not i Is Nothing Then
    If i.Value = "REMOVE" Then
      Call ClearCells(i)
    End If
    Exit Sub
  End If
     
End Sub
Click to expand...
I am using your 2 previous:

VBA Code: 
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
            Sheets("Board").Range("A1").End(xlDown).Offset(1).PasteSpecial Paste:=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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Escape
    Application.EnableEvents = False
    
    If Not Intersect(Range("G2:G750"), Target) Is Nothing Then
        Cancel = True
        With Target.Cells
            .Copy
            Sheets("Board").Range("F1").End(xlDown).Offset(1).PasteSpecial Paste:=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

This allows me to click H to add data from to Board row A and to double-click G to add date from G to the corresponding row on Board column G. So, I would like the above to work as it is while adding the copy/paste from Board (2) to Board. I tried the Clearcells independently and get "Argument Not Optional".
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Worksheet Change - multiple Loops in one sub
2
Replies
13
Views
202
mumps
mumps
W
  • Solved
Code for rows of cells returning reverse-order values.
Replies
5
Views
144
Worksong
W
H
  • Question
Error 1004: Copy method of Range class failed
Replies
2
Views
268
Alex Blakenburg
A
M
  • Question
add a Find/Update button to my userform1 that will allow me to find a report # in my worksheets, repopulate the userform.
Replies
7
Views
154
dmt32
D
S
  • Question
Remove simple multiplication from formulas in a selection of cells
Replies
1
Views
306
Herakles
H

Forum statistics

Threads
1,214,632
Messages
6,120,649
Members
448,975
Latest member
sweeberry

Share this page

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