Excel VBA: click button that duplicates and then inserts the row - excel

I am writing code for a button in Excel with the intention of taking the row number of the clicked button, duplicate the corresponding row given the row number, and then inserting and shifting the duplicated row below the original row of the click button. See the pictures for example:
Click here for picture before button is pressed.
Click here for picture after button is pressed.
I have tried several revisions of code based on solutions to similar issues I find online such as here and here(among other places), but I cannot find a solution to my reoccurring error which is Unable to get the Buttons property of the Worksheet class. From what I've gathered online about this error, it occurs often when any argument passed to the worksheet function is not of the correct type or simply doesn't make sense. Below I posted two iterations of my codes;
Private Sub CorrugatedR_Click()
Dim b As Object, RowNumber As Integer
ActiveSheet.Activate
Set b = ActiveSheet.Buttons("CorrugatedR")
With b.TopLeftCell
RowNumber = .Row
Rows(RowNumber + 1).Insert Shift:=xlDown
Rows(RowNumber).Copy Rows(RowNumber + 1)
End With
End Sub
The other version, which should do the same thing(I've been doing a lot of playing around):
Private Sub CorrugatedR_Click()
Dim b As Object, RowNumber As Integer
ActiveSheet.Activate
ActiveSheet.Buttons("CorrugatedR").Select
ActiveSheet.Buttons("CorrugatedR").Copy
b.Paste
With b.TopLeftCell
RowNumber = .Row
End With
Rows(RowNumber + 1).Insert Shift:=xlDown
Rows(RowNumber).Copy Rows(RowNumber + 1)
End Sub
A quick important note is that originally instead of calling the button's name itself: ActiveSheet.Buttons("CorrugatedR") I implemented ActiveSheet.Buttons(Application.Caller) instead because several people made this suggestion, but this gave me another error Application.Caller = Error 2023. After doing research I think these problems both relate to the same reoccurring issue that ether it's relating to typing or something i'm unaware of; I tried implementing and using the information from the solution to the same error found here, and still no luck. My intuition is that the issue may lie in the code where I set b: Set b = ActiveSheet.Buttons("CorrugatedR")
I'm still new to VBA and Excel, so my whole approach could be miscued in itself, and I would really appreciate any help, I've been stuck on this one for a while.

If your code is in a module, this sample code will work (replace CommandButton1 with the name of your button):
Private Sub example()
MsgBox ActiveSheet.CommandButton1.TopLeftCell.Row
End Sub
...Or if your code is on the sheet:
Private Sub CommandButton1_Click()
MsgBox Me.CommandButton1.TopLeftCell.Row
End Sub

Related

Printing from dynamic Excel list box

I have a workbook that is a 'quick print' sheet for my workplace.
I am not very skilled with VBA, but I have found various bits from web searches that have given me mostly desired results.
This is the desired look of the sheet:
The column C and D is a List Box with the VBA code:
Private Sub Worksheet_Activate()
Dim Sh
Me.ListBoxSh.Clear
For Each Sh In ThisWorkbook.Sheets
Me.ListBoxSh.AddItem Sh.Name
Next Sh
End Sub
The print icon in D2 is linked to macro:
Sub Print_Sheets()
Dim i As Long, c As Long
Dim SheetArray() As String
With ActiveSheet.ListBoxSh
For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve SheetArray(c)
SheetArray(c) = .List(i)
c = c + 1
End If
Next i
Application.Dialogs(xlDialogPrinterSetup).Show
Worksheets(SheetArray()).PrintOut Copies:=1
End With
End Sub
and finally the sheet has following in ThisWorkbook in order to refresh the List Box and put the user on the correct page:
Private Sub Workbook_Open()
Sheets(2).Select
Sheets(1).Select
End Sub
The final bit of VBA seems to work as intended, but I included it anyway in case it could interfere with something (I don't think it can, but just to be sure).
The List Box populates as intended, but I can't get it to stay the width of the columns C:D, and the height of the populated cells in B, every time the workbook is opened the box will increase in size both to the right and down.
The print button works mostly as intended; when clicked it will prompt with available printers, and then OK to print, but cancelling still causes the document to print. It will also allow the printing of the "Please Select..." page - the name of the sheet this form is on - which I have tried to stop from happening but can't get it to work.
On the point of having the list box resize correctly, I have followed this answer but I can't figure out how to keep the size as the range, rather than an integer.
Edit: I have now figured out that I can use Me.ListBoxSh.Width = Range("C:D").Width to set the width the same as the desired columns, as well as Me.ListBoxSh.Height = Range("3:7").Height for the height in the image shown. However, I will be adding to this list and am not sure how to have the VBA code work as "Start in row 3 and continue until an unpopulated row".
On not being able to print the "Please Select..." sheet, I followed this guide and it didn't seem to do anything at all. I had changed the WsName = "Sheet1" line to read WsName = "Please Select..." also.
Any help would be appreciated.

Disable a specific form control button from running its assigned macro even if it is clicked

I would like to be able to prevent a specific button ("Button 4925") from running its assigned macro even when it is clicked. Basically, when you click it, it would either do nothing or show a message that says " This is an essential item that cannot be deleted"
In other words, I would like to be able to exit the sub only if the clicked button is in cell A12. Otherwise, run the code as normal. I don't know how to do that considering that I am a very beginner in VBA.
Some information:
The button is a form control button. Not an Active X one. It gets copied and pasted by another macro on the sheet. The assigned macro is written under a Standard Module.
The assigned macro function is to delete a relative range of rows. Here is the code:
Sub Delete_Button()
' Delete_Button Macro
' Step 1: Select the cell under the clicked button
Dim r As Range
Dim s As Object
Set r = ActiveSheet.Buttons(Application.Caller).TopLeftCell
r.Select
' Step 2: delete all buttons relative to the selected cell from step 1
StartCell = ActiveCell.Offset(-5, 0).Address
EndCell = ActiveCell.Offset(0, 0).Address
For Each s In ActiveSheet.DrawingObjects
If Not Intersect(Range(StartCell, EndCell), s.TopLeftCell) Is Nothing Then
s.Delete
End If
Next s
' Step 3: delete the rows relative to the selected cell from step 1
ActiveCell.Offset(-7, 0).Rows("1:9").EntireRow.Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(-4, 0).Range("A1").Select
End Sub
You must 'tell' to the code, in a way, that it must not delete the range.
So, I would suggest you to create a Private variable on top of the module keeping the button code (in the declarations area):
Private stopButCode As Boolean
Than, you must make this variable True. Use a Check box, or a piece of code in another control to make it True.
The Button code must be adapted in a way like following:
If Not stopButCode Then
'delete whatever is to be deleted
Else
MsgBox "Deletion not allowed..."
Exit Sub
End If
Edited:
If you want the code not working only if the button will be on cell "A12", you can use adapt your code as following:
Dim r As Range
Dim s As Object
Set r = ActiveSheet.Buttons(Application.Caller).TopLeftCell
If r.Address = "$A$12" then Exit Sub
'here follows your existing code...

Changing Userform Label derived from one worksheet when inputting on a different worksheet

I have a worksheet that runs a weightlifting meet. Last year I had created a tab that would give information on the current lifter and on who was lifting next.
left side - Display, right side - input tab
When I input an "x" in columns R, S, T, or W on the data tab, it changes the information in the BenchGenerator tab, like so:
Updated Display tab
What I want to do is make a userform display to run on a different screen so people can see this information. I had accomplished this last year by widening excel and using two view windows - display on the second screen and running the meet on the computer. It was ok but very clunky looking. With a floating userform tab, it would look fantastic. I am new to this, but got the form floating:
Private Sub Worksheet_Change(ByVal Target As Range)
UserForm1.Show (vbModeless)
End Sub
And got the labels to initially populate:
Userform Display
Using this code:
Private Sub UserForm_Activate()
UserForm1.Label1.Caption = Sheets("BenchGenerator").Range("c4").Value
UserForm1.Label2.Caption = Sheets("BenchGenerator").Range("c5").Value
UserForm1.Label3.Caption = Sheets("BenchGenerator").Range("c6").Value
UserForm1.Label4.Caption = Sheets("BenchGenerator").Range("d3").Value
UserForm1.Label5.Caption = Sheets("BenchGenerator").Range("d4").Value
UserForm1.Label6.Caption = Sheets("BenchGenerator").Range("d5").Value
UserForm1.Label7.Caption = Sheets("BenchGenerator").Range("d6").Value
End Sub
What it doesn't currently do is update the captions when I input the "x" in the data tab.
As I mentioned, this is my first foray into userforms and looking through mountains of code trying to figure this out, it will not be my last as there is lots to accomplish with them.
Thanks in advance for any help!
You're pretty close to getting this to work. The problem is that your calling a new form every time a change occurs.
Declare your form as an object outside of the Sub that creates (Show) it.
You can then access it to update labels from another Sub that has the same scope.
Create an UpdateForm sub for example and call it from your Worksheet_Change event.
Try this, place the following code in a new Module:
Dim myForm As Object
Sub launchForm()
Set myForm = UserForm1
myForm.Show (vbModeless)
End Sub
Sub updateForm()
Dim wks As Worksheet
Set wks = Sheets("BenchGenerator")
'Update label values here
myForm.Label1.Caption = wks.Range("C4").Value
myForm.Label2.Caption = wks.Range("C5").Value
myForm.Label3.Caption = wks.Range("C6").Value
myForm.Label4.Caption = wks.Range("D3").Value
myForm.Label5.Caption = wks.Range("D4").Value
myForm.Label6.Caption = wks.Range("D5").Value
myForm.Label7.Caption = wks.Range("D6").Value
End Sub
If you use Worksheet_Change to update the form you'll want to verify the form exist or just skip any errors in the event if it doesn't.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
updateForm
End Sub
Not sure if there is an easier way to do it, but I made a concatenation routine to batch out my label setup and updates to quickly create/copy/paste all the code.
Just in case anyone didn't know how to do this

Allow null input when retrieving data from multiselect listbox

I'm trying to create a simple worksheet-based form that will pull data from the selections into another sheet on the Excel workbook. This is my first time messing with Visual Basic and ActiveX controls and I don't have much programming experience, but with a lot of Googling I've managed to muddle through some so far.
The part in question: I have a couple of multiselect boxes that, with the click of a button, push the data into the spreadsheet, using this code:
Private Sub CommandButton1_Click()
Dim I As Long
Range("A10").Select
Range(Selection, Selection.End(xlToRight)).ClearContents
With Me.ListBox1
For I = 0 To .ListCount - 1
If .Selected(I) Then
Flg= True
txt = txt & "," & .List(I)
End If
Next
End With
If Flg Then
With Sheets("Sheet1")
.Range("A10").Value = Mid$(txt, 2)
End With
End If
txt=""
'Repeat for each listbox'
End Sub
As long as the user has selected at least one item in each listbox, this works fine to pull the data, and from there I can do what I need. But I don't want to require the user to click in each box (that is, I suppose I could force them to click a null selection if they don't want to select something in that box, but it would be easier to just have them not select anything at all). But (understandably) when nothing is selected in a given box, the code I pasted above returns run-time error 1004: No data was selected to parse.
How can I permit the user to make no selection in a box, and have the code just leave the associated cell blank when the data are retrieved?
Wow, after a couple of days of looking I finally found it. This is the code that worked for me:
Private Sub ListBox1_LostFocus()
Dim listItems As String, i As Long
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then listItems = listItems & .List(i) & ", "
Next i
End With
If Len(listItems) > 0 Then
Range("A2") = Left(listItems, Len(listItems) - 2)
Else
Range("A2") = ""
End If
End Sub
And it came from this page: https://www.mrexcel.com/forum/excel-questions/584437-write-selections-excel-listbox-cell.html ...thanks to 'Marcelo Branco' for providing that answer 7 years ago!
EDIT - This really answers a separate question that I had (about retrieving the data automatically), but it seems to also work for the big question here, since when nothing is selected, the target cell is blank.

Check box general selector and macro to show next three rows when one checkbox is selected

I am new to macros so I'm not sure this is possible in VBA.
I am trying to create a document where is composed with many mini tables made of 4 rows.
One row is the title which have a checkbox and will always be shown and three rows below where contains data that I only what to see when I select the relevant checkbox.
This document will have many mini tables hence many check boxes and I was wondering if there is a generic selector for checkboxes where I can apply the same macro.
I have seen the following macro, but this will apply only to one check box and I was wondering if there was a way to apply one for all checkboxes saying that if checkbox in row 4 is selected then show row 5,6 and 7. If checkbox in row 8 is selected then show rows 9,10,and 11 and so on....
Private Sub CheckBoxRow4_Click()
Rows("5:6:7").Hidden = CheckBoxRow4.Value
End Sub
See screenshot for a better idea.
It would also be appreciated if you could indicate how can I get those three rows below hidden by default when opening the document.
I am using Excel 2011 for Mac if that makes any difference.
Thank you in advance.
I'm sure there will be several approaches to this. My first thought goes to adding checkboxes, linking them all to a single macro. When activated, you have to do several things:
find out who is calling the sub (which checkbox);
find out where that specific checkbox is located (which row);
hide / unhide the rows below it.
1:
The name of the checkbox is easy. Application Caller will give you that.
2:
Location is the real problem here. I don't see a simple solution here, other then giving the checkboxes such specific names, that it is clear which row it is in. If you add a checkbox, you can give the name in the 'named range' inputfield. If you give it names that will specify the rows it must hide, it is even better. So something like:
HIDE_4_7 would indicate the checkbox must hide / unhide rows 4 to 7.
3:
Hiding the rows is now easy.
total solution:
Sub HideRows()
Dim cbName As String
Dim cbValue As Boolean
Dim s() As String
Dim firstRow As Long
Dim lastRow As Long
On Error Resume Next
cbName = Application.Caller
If Err.Number <> 0 Then Exit Sub 'sub is not called from an application object
cbValue = (ActiveSheet.CheckBoxes(cbName) = xlOn)
If Err.Number <> 0 Then Exit Sub 'sub is not called from a checkbox
On Error GoTo 0
s = Split(cbName, "_")
If s(LBound(s)) <> "HIDE" Then Exit Sub 'name of the shape is not valid
firstRow = Val(s(LBound(s) + 1))
lastRow = Val(s(LBound(s) + 2))
Sheets(1).Rows(firstRow & ":" & lastRow).Hidden = Not cbValue
End Sub
You would have to call the checkboxes HIDE_*firstrow*_*lastrow*, and link them to this sub. That works on my side.
EDIT
To hide all rows on opening, you could use the Workbook_Open sub (in the workbook code storage thingy). Something like this:
Private Sub Workbook_Open()
Dim shp As Shape
Dim s() As String
Dim firstRow As Long
Dim lastRow As Long
Dim cbValue As Boolean
For Each shp In Sheets(1).Shapes
Debug.Print shp.Name
s = Split(shp.Name, "_")
If s(LBound(s)) <> "HIDE" Then GoTo nextShp
'set checkbox off:
Sheets(1).CheckBoxes(shp.Name) = xlOff
firstRow = Val(s(LBound(s) + 1))
lastRow = Val(s(LBound(s) + 2))
Sheets(1).Rows(firstRow & ":" & lastRow).Hidden = True
nextShp:
Next shp
End Sub

Resources