Is there a way to generalize my repeated VBA code into one macro that I could apply to ALL buttons?

[luismoran]

I have this "library" type file where I have attached buttons on every row in Column A. Each one of these buttons does the same action but ends up in a slightly different viewpoint.
Once the button is clicked this code is ran for each button, (four examples below)

Sub pressures19099ZN()
    Sheets("PRESSURES").Select
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "19099-zn"
End Sub
Sub pressures19115OSV()
    Sheets("PRESSURES").Select
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "19115-osv"
    Range("U3").Select
End Sub
Sub pressures19159zn()
    Sheets("PRESSURES").Select
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "19159-zn"
End Sub
Sub pressures19169zn()
'SELECTS SHEET TO GO TO
    Sheets("PRESSURES").Select
'SELECTS THE CELL
    Range("U2").Select
'ENTERS IN WHATS INSIDE THE QUOTATION MARKS
    ActiveCell.FormulaR1C1 = "19169-zn"
End Sub

1. Switches from PARTS sheet to PRESSURES sheet
2. Enters in the part number they clicked on from Column A into the search box on the second sheet
3. The search bar uses conditional formatting to highlight the line.
   1. Uses the following code to scroll to the exact row that part number is on (Thanks to Akuini on MrExcel)

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$P$2" Then
        Dim c As Range
        Set c = Range("A:F").Find(What:=Target, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not c Is Nothing Then
                c.Activate
                    ActiveWindow.ScrollColumn = 1
                    ActiveWindow.ScrollRow = c.Row
            Else
                MsgBox "Cant't find " & Range("P2") & " in Part Numbers"
            End If
    End If

End Sub

I was wondering If it was able to simplify the code I have for each button to one singular macro that could be applied to all the buttons? I'd greatly appreciate any help. If you need a copy of the excel file to work on, I got it ready on a google drive, just let me know.

 

[DanteAmor]

Hello @luismoran

What kind of button is it?
It is a shape, it is an activex control commandbutton or a form control commandbutton, or put an image to see how you insert one of those buttons.

Are the buttons on the same sheet "PRESSURES" or are they on another sheet?

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

 

[luismoran]

Hello @luismoran

What kind of button is it?
It is a shape, it is an activex control commandbutton or a form control commandbutton, or put an image to see how you insert one of those buttons.

Are the buttons on the same sheet "PRESSURES" or are they on another sheet?

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

Hi, it is a form control button! I'll attach the google sheet if you want to take a look as well. There might be a password on the sheet, if so the password is dupage311

Copy of Parts Finder.xlsm

PARTS PARTS FOR ASSEMBLY SEARCH:,16120 Assembly P/N,Retainer P/N, Tube P/N ,Plug P/N,Tube Braze Ring , Plug Braze Ring ,Plug Support,Tool Post,Gauge Pin,Box Partitions, Pcs/ box ,Customer 15999,16079,15998,16555,Ø.490 x .025,Ø.426 x .031 ,16317,15999,1.400" ,16120,270 16089,16094,16093,16091,Ø...

docs.google.com

 

[DanteAmor]

I was able to open your file, but it has some corruption that doesn't allow me to save it.
I had to copy each sheet into a new book.

I recommend removing all your buttons, so you won't have to fight with a lot of macros.

Under each button I noticed that you have the Assembly number.

So my recommendation is that you double-click on the cell in column A and it will automatically switch to the PRESSURES sheet and update cell U2 with the value where you double-clicked.

You only need this code in the PARTS sheet events.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("A4:A" & Rows.Count)) Is Nothing Then
    Cancel = True
    With Sheets("PRESSURES")
      .Select
      .Range("U2").Select
      .Range("U2").Value = Target.Value
    End With
  End If
End Sub

I return my evidence file for you to try.

Copy of Parts Finder dam2.xlsm

drive.google.com

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[luismoran]

I was able to open your file, but it has some corruption that doesn't allow me to save it.
I had to copy each sheet into a new book.

I recommend removing all your buttons, so you won't have to fight with a lot of macros.

Under each button I noticed that you have the Assembly number.

So my recommendation is that you double-click on the cell in column A and it will automatically switch to the PRESSURES sheet and update cell U2 with the value where you double-clicked.

You only need this code in the PARTS sheet events.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, Range("A4:A" & Rows.Count)) Is Nothing Then
    Cancel = True
    With Sheets("PRESSURES")
      .Select
      .Range("U2").Select
      .Range("U2").Value = Target.Value
    End With
  End If
End Sub

View attachment 94077



I return my evidence file for you to try.

Copy of Parts Finder dam2.xlsm

drive.google.com

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

WOW, that is amazing! Muchismas gracias, te lo agradezco !

 

[DanteAmor]

Have a nice day!
Encantado de ayudarte, gracias por comentar.