Excel VBA: getting row of clicked button [duplicate] - excel

This question already has answers here:
Get corresponding Range for Button interface object
(3 answers)
Closed 3 years ago.
I am trying to make a button in Excel which copies a certain range of cells from the active workbook to another workbook. The copying of this range works perfectly when I specify a fixed range, but I am stumped on how to figure out the row of the clicked button.
Every row contains 7 or so cells, and the 8th cell contains a shape with a macro attached to it (the button).
When the user presses this button the 7 cells on the same row as the row containing the pressed button need to be copied.
Using ActiveCell is of no use, since pressing the button doesn't actually set that cell as active. I searched around a lot but I can't seem to find how to obtain this value.
Once I have the row number of the clicked button I can figure the rest out on my own.

Each Shape has TopLeftCell property. It contains a cell within which the top left corner of the shape resides.

Try this:
Sub Mainscoresheet()
' Mainlineup Macro
Dim b As Object, cs As Integer
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
cs = .Column
End With
MsgBox "Column Number " & cs
End Sub

Excellent answer. Btw It also works for Rownumber!
'Same for rownumbers!
Sub Mainscoresheet()
' Mainlineup Macro
Dim b As Object, RowNumber As Integer
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
RowNumber = .Row
End With
MsgBox "Row Number " & RowNumber
End Sub

This works too! Selects the cell that the generated button resides in (knew it was in column "K" but that could be calculated too!.
ActiveSheet.Range("K" & ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row).Select

Related

Delete a Shape (Spin Button) based on Active Cell.Offset variable

I want to delete the spin box relative to the active cell (Column A, same row).
I think the issue is in using .Value in the IF statement, .Address did not work .Value doesn't delete the active Check Boxes but it does delete all the other Check Boxes & Spin Buttons.
Spreadsheet Intended Use
In Column A there are check boxes with IF statements that when checked (true), add the date in the previous row +1 to current row Column B, a spin button in Column D (linked to column C) and a Spin Button in column F (linked to Column E). This coding is working.
When the check boxes are unchecked (False), I have code to clear the contents of the cells in that row using ActiveCell.Offset (the A column cell) and I want to delete the spin buttons so they can't be accidentally used to add values to cleared cells.
Another Submit button will simply copy the data entered by users and paste in another sheet for analysis. This button will also reset the sheet.
Below code is only trying to delete one Spin Button, I will copy, paste and update the offset for the second Spin Button when it works. The Spin Button with the red arrow should be the only one deleted.
Original code was found in the below post. I tried to adapt it to use a variable.
VBA-delete shapes
Sub RemoveSpinBoxes()
Dim sh As Shape
Dim OptionOneSpin As Range
Set OptionOneSpin = ActiveCell.Offset(0, 3)
For Each sh In ActiveSheet.Shapes
Debug.Print sh.Name
Debug.Print sh.TopLeftCell.Address
Debug.Print sh.BottomRightCell.Address
If sh.TopLeftCell.Value = OptionOneSpin And sh.BottomRightCell.Value = OptionOneSpin Then
Debug.Print sh.Name; " is deleted!"
sh.Delete
Else
End If
Next
End Sub
Found the solution. Just copy, paste the block and offset differently for more shapes.
Sort of understand how it's working. As #DecimalTurn suggested in regards to the cells implicit value, it's returning a False now and that is why it's working. Also using the intersect parameter makes it more reliable I guess?
Solution source here Adapted from Bukimis second post.
Sub RemoveSpinButtons()
Dim Shape As Shape
For Each Shape In wsSpinButtons.Shapes
If Not Intersect(Shape.TopLeftCell, ActiveCell.Offset(0, 3)) Is Nothing Then
Shape.Delete
Exit For
End If
Next Shape
End Sub

Visual Basic Excel create Checkbox in Code

I've added a button to an Excel file which, when clicked, reads a text file and populates a column with lines from a text file. I need to add a checkbox to cells adjacent to certain lines, depending on what the line contains.
Can I create components like checkboxes in code, and if so, how?
Any responses are appreciated.
While the link #Siva provided is certainly valid I just prefer to have an answer on StackOverflow instead of an external link. Hence, here is the solution you might be looking for:
Option Explicit
Public Sub tmpSO()
Dim i As Long
Dim chk As CheckBox
With ThisWorkbook.Worksheets(1)
.CheckBoxes.Delete
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(i, "A").Value2 = "need checkbox" Then
Set chk = .CheckBoxes.Add(Left:=.Cells(i, "B").Left, Top:=.Cells(i, "B").Top, Width:=.Cells(i, "B").Width, Height:=10)
chk.OnAction = "runThisSub"
chk.Name = "CheckBowInRow" & i
chk.Caption = "CheckBowInRow" & i
End If
Next i
End With
End Sub
Sub runThisSub()
MsgBox "You clicked the checkbox " & Application.Caller _
& Chr(10) & "in cell " & ThisWorkbook.Worksheets(1).CheckBoxes(Application.Caller).TopLeftCell.Address
End Sub
Copy both subs into a Module into your Excel file and change in the first sub
the sheet where the text is imported to (here it is Worksheet(1)),
the column where the condition can be found (here column A), and also
what the condition is (here the value in column A must be need checkbox).
The code will now look through all cells in column A in sheet Worksheet(1) and check if the value is need checkbox. If so, the code will automatically add a checkbox into column B adjacent to that cell.
If you click on any of the newly created checkboxes then the second sub fires up and will show you in a message box which checkbox in which row has been clicked.

Is There A Fast Way To Add Multiple Text boxes With Scrollbars?

Because the cells in my project contain so much data I have had to insert textboxes that have scrollbars to see all the data (they are linked to the cell which sit behind them on the spreadsheet). Is there any fast way to do the same thing on a column of 1000 records or will I have to go through manually and link the textbox to the specific cell? Is there a faster way?
Also If an issue comes in that is a reply to the original issue I need it to use the original ID (I have used auto IDS, which can be seen in the spreadsheet). Any recommendations?
Slowly I am getting better at excel and VBA but I need a hand sometimes ^_^
I have attached the spreadsheet which contains an example of 2 records I made. The final sheet will have 1000 records. (Please download the spreadsheet and open in excel)
LINK To Spreadsheet
A few things:
You should change the cell formatting to "Top Align" the text in the cells. This will cause the cell to show the first line of the long text in the Query cells.
Instead of using the "send email" text in a cell why not add a single button to email the currently selected row. (use insert on the ribbon in the developer tab (you have to change the excel options to show the developer tab).
The code to send an email might be better if it updated a new column with the date it was sent, and in the event that it has already been sent, it could prompt the user to confirm.
if not isempty(cells(r, ColNumberWithSentdate) ) then
if vbno = msgbox ("Are you sure you want to send the email again?", VbYesno) then
Exit sub
end if
end if
All the textboxes you have added are really slowing down the spreadsheet.
why not just have one tall row at the top above the table with the filters. The tall row would show the data from the currently selected row in the table. Your table rows could then probably be less high.
Add a single text box.
Use ALT+click and drag to resize text boxes to fit cell exactly.
Change or view the name of the textbox in the named range area to "TextBoxQuery".
Add code to change the text in the summary row
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Say the tall row is in row 2
If Target.Row <= 2 Then
Exit Sub
End If
Dim i As Integer
For i = 1 To 8
Cells(2, i) = Cells(Target.Row, i)
Next i
End Sub
You could even allow the user to edit the text in the tall row and add a button to save the changes they entered:
A. Add an ACTIVEX button in the summary row labelled "SAVE"
(Then you can edit the vba in the sheets module for the button)
B. Add a cell somewhere that records which row is being displayed in the summary row.
C. When the save button is clicked, write code that copies all the values in row to back to the row recorded.
NOTE that if the user deletes a row in the table or sorts the data in the table the row stored will be wrong. So before copying the data, you might like to check to see whether the row has moved. ie check a KEY value (ie ones that never changes) is the saem in both rows.
Private Sub CommandButton1_Click()
Dim i As Integer
For i = 1 To 8
Cells(Cells(1, 1).Value, i) = Cells(2, i)
Next i
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Say the tall row is in row 2
If Target.Row <= 2 Then
Exit Sub
End If
' Cell A1 is used to store which row is displayed
Cells(1, 1) = Target.Row
Dim i As Integer
For i = 1 To 8
Cells(2, i) = Cells(Target.Row, i)
Next i
End Sub

Set cell vlookup value based on changing Combobox value

I have input a combobox in an Excel sheet. I want it to work so that the user who does not have access to the VBA can select a value from the dropdown and then the value in another cell will perform a vlookup on this value.
In the first instance I have inserted a box and am trying to set a cell value based on this.
Sub InsertComboBox()
#inserts dropdown box on the front page and sets the values as the list of DMA from the pipe_totals sheet
#this should be the most complete list so will not change dependant on asset
Dim arearange As Range
Set arearange = Sheets("pipe_totals").Range("a:a")
lastrowi = Application.WorksheetFunction.CountA(arearange)
Sheets("front page").Activate
With Range("f5:g5")
Set Combo = ActiveSheet.DropDowns.Add(.Left, .Top, .Width, .Height)
End With
Combo.List() = Sheets("pipe_totals").Range("A2:A" & lastrowi).Value
.Range("k9").Value = Combo.Value 'only works on current combobox value which is 0
End Sub
Is there a way I can set this so the vlookup is dynamic depending on the users selection?
In this example, just set the right combo name. It should be ok, provided that your combobox lists values from "Range("A2:A" & lastrowi)" as you mention above.
Sub "comboname"_Change()
Dim list_val As Long
list_val = Worksheets("front page").Shapes("comboname").ControlFormat.Value
Range("K9") = Worksheets("pipe_totals").Cells((list_val + 1), 1)
End Sub
Sub test()
Dim z As Shape
For Each z In Worksheets("front page").Shapes
Debug.Print z.Name
Next z
End Sub
As far as I understand, you want that everytime the combobox value changes, cell K9 will have the same value also. Is that right? If this the case, then right click on the combobox and select "Assign Macro". Then select "Create". Then inside the sub created, which should look like this:
Sub "comboname"_Change()
End Sub
You should also paste the final code line.
.Range("k9").Value = Combo.Value
Doing so, means you want that line of code executed every time the combobox value changes.

Copy range and store them on a different sheet

I think this is not a too difficult task to do, but the problem is that I actually don't know anything about programming and I need to do this on my current job. This is my issue:
The problem is that I have to develop a Macro, and assign it to a button, that copies range E3:K14 from Page 1(sheet1) and paste it on A1 on Page 2(sheet2). This first task is rather easy, but the problem comes when if I hit again the button's assigned Macro it has to copy the same range from Page 1 and paste it on Page 2 but if the first has to check if there already something pasted on A1, if there is, then it must copy it on cell I1 and if I click the button again to Q1 and so on.
When the range is pasted it must be pasted with "Paste Vales" option.
If someone could just put me the exact code (with some comments if possible) for me just to paste it would be really helpful.
Any help would be really appreciated!
Try below code :
Sub sample()
With Sheets("Sheet2")
Sheets("sheet1").Range("E3:K14").Copy .Cells(.Range("A" & .Rows.End(xlUp).Row) + 1, 1)
End With
End Sub
Explanation :
Have used the Range Copy Method and provided a destination where to
paste.
.Range("A" & .Rows.End(xlUp).Row) + 1 checks for last used cell in sheet2 column A and adds 1 so that data is pasted on last used row.(Assuming the column E does not have blank cells)
Dude you can use this code to get the last column with data, this is the key for solve your problem.
Sub SelectLast()
Dim LastColumn As Long
With ActiveSheet
LastColumn = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
End With
MsgBox LastColumn
Cells(18, LastColumn + 2).Select
End Sub

Resources