Reducing the amount of code

mark hansen

Well-known Member
Joined
Mar 6, 2006
Messages
534
Office Version
  1. 2016
Platform
  1. Windows
I have the following code on 100 sheets along with 5 buttons to pick up a list of questions and answers from certian cells and put it in the clipboard for later pasting. Each of the 100 sheets are basically the same, except the questions and answers are different. (sorry, I don't know why the code is in different colors)

I was wondering if I can put the code on one place (instead of the same code on 100 pages) and have the 5 buttons on each page run the code BUT pick up the questions on the sheet they are on.

As each page in the VBE has the same code, I was hoping I can do something a bit different to reduce the overall amount of code and perhaps the excel file can be smaller.

(The worksheet selection change event allows certain cells to be clickable and act like buttons to insert text as the answer. I did this to reduce the amount of buttons drastically and the file size.

Can I put this code in the "ThisWorkbook" area and somehow reference the current sheet when the button is clicked so it uses the current sheet's questions? If so, how would I modify the code so button 1 does the same thing, but with the sheet its on?

PHP:
Private Sub CommandButton1_Click()
Call copy_to_so
End Sub

Private Sub CommandButton2_Click()
Call clear
End Sub

Private Sub CommandButton3_Click()
Range("D111").Value = Range("D110").Value
Range("D111").Copy
   Application.WindowState = xlMinimized
End Sub

Private Sub CommandButton4_Click()
Call copy_to_so
End Sub
Private Sub CommandButton5_Click()
Call clear
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Rem  Determine if user has selected a cell in the range of interest
   If Not Intersect(Target, Range("G5:K54")) Is Nothing Then
    If Len(ActiveCell.Value) = 0 Then
     Exit Sub
   End If
      With Target
   '  MsgBox (ActiveCell.Column)
         If ActiveCell.Column = 7 Then
           Range("E" & ActiveCell.Row) = Range("S" & ActiveCell.Row)
         End If
         If ActiveCell.Column = 8 Then
           Range("E" & ActiveCell.Row) = Range("V" & ActiveCell.Row)
         End If
         If ActiveCell.Column = 9 Then
           Range("E" & ActiveCell.Row) = Range("Y" & ActiveCell.Row)
         End If
         If ActiveCell.Column = 10 Then
           Range("E" & ActiveCell.Row) = Range("AB" & ActiveCell.Row)
         End If
         If ActiveCell.Column = 11 Then
           Range("E" & ActiveCell.Row) = Range("AE" & ActiveCell.Row)
         End If
      End With
' ActiveSheet.Protect
   End If
End Sub

Thanks for any ideas?
Mark
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
In the ThisWorkBook module there is a:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

End Sub
 
Upvote 0
Sorry for the delay in getting back to you, family issues...

Moving it to the Thisworkbook area doesn't work. Do I need to modify the code to tell it to use "this worksheet" or something like that?

I made some changes to the above code. I added a line on each area to put a number 1-5 in a cell in another column.

I figure the button code to call a sub routine is OK, there is the new change selection code

PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Rem  Determine if user has selected a cell in the range of interest
   If Not Intersect(Target, Range("G5:K54")) Is Nothing Then
 If Len(ActiveCell.Value) = 0 Then
   Exit Sub
 End If
 
      With Target
   '  MsgBox (ActiveCell.Column)
         If ActiveCell.Column = 7 Then
           Range("E" & ActiveCell.Row) = Range("S" & ActiveCell.Row)
           Range("AJ" & ActiveCell.Row) = "1"
         End If
         If ActiveCell.Column = 8 Then
           Range("E" & ActiveCell.Row) = Range("V" & ActiveCell.Row)
           Range("AJ" & ActiveCell.Row) = "2"
         End If
         If ActiveCell.Column = 9 Then
           Range("E" & ActiveCell.Row) = Range("Y" & ActiveCell.Row)
           Range("AJ" & ActiveCell.Row) = "3"
         End If
         If ActiveCell.Column = 10 Then
           Range("E" & ActiveCell.Row) = Range("AB" & ActiveCell.Row)
           Range("AJ" & ActiveCell.Row) = "4"
         End If
         If ActiveCell.Column = 11 Then
           Range("E" & ActiveCell.Row) = Range("AE" & ActiveCell.Row)
           Range("AJ" & ActiveCell.Row) = "5"
         End If
   
         
      End With
   End If
End Sub

So, do I need to add something to tell it to work with the current sheet I'm on?
 
Upvote 0
OK, Jim... I re-read your response closer and understood it better. THANKS!!, that did the trick.

Sorry for the delay in getting back to you. Tying to get back into the swing of things.

thanks again,
Mark
 
Upvote 0

Forum statistics

Threads
1,224,595
Messages
6,179,798
Members
452,943
Latest member
Newbie4296

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