I have two sheets and one userform.
Sheet2 starts off completely empty. Sheet1 is completely empty except for one ActiveX command button that opens the userform when clicked.
The userform has one single label, that when clicked, will run some vba code that (1) inserts an image at a specified location in Sheet2 and then (2) inserts a row in Sheet2 above the image
My goal is to click on the userform's label X number of times such that I will end up with X number of images in sheet2 each separated one row apart from each other (my actual use case involves different images).
The problem I am facing is that when I first open the excel file (with sheet1 as the default sheet that appears upon opening) and start using my ActiveX command button as described, then when I navigate over to sheet2 to take a look, the images in sheet2 are all clustered together on top of each other.
Strangely enough, after I navigate over to sheet2 to take a look, then navigate back to sheet1 to continue using the ActiveX command button, then navigate back to sheet2 again to take another look, the subsequent images are now all neatly spaced out as intended.
Is there a way to make sure that right from the start, the images don't cluster when I first open my excel file and use the ActiveX command button?
Code contained in sheet1
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Code contained in the userform (substitute your own pic filepath)
Private Sub Label1_Click()
Dim pic
Set pic = Sheet2.Shapes.AddPicture(Environ("USERPROFILE") & "\" _
& "Pictures\Account Pictures\monkey selfie.jpg", _
False, True, 1, 1, -1, -1)
pic.LockAspectRatio = msoTrue
pic.Placement = xlMoveAndSize
If pic.Height / pic.Width <= 14.3 / 47 Then
pic.Width = 40
ElseIf pic.Height / pic.Width > 14.3 / 47 Then
pic.Height = 10
End If
With pic
.Top = 20
.Left = 20
End With 'this position corresponds to cell A2
Sheet2.Range("A2") = "Filled" 'to indicate that the cell _
is supposed to contain an image
Sheet2.Rows(2).Insert Shift:=xlShiftDown 'both the image and _
the word "Filled" should be pushed down one row
End Sub
Thank you!
Related
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
I have two worksheet; cal and sketch. In sketch, I have two pictures; Picture 1 and Picture 2. In worksheet cal, I have a cell with a dropdown list; contents of the list are 'Port' and 'Starboard'.
I would like to have Picture 1 or Picture 2 copy to cal.Cells(25, 1) when the dropdown changes; replacing whatever picture was there before hand.
I have the code working for the changing of the cell and it copies a Picture. It just ALWAYS copies Picture 1.
Sub import_sketch()
Dim my_sketch As Picture
If Cells(8, 27) = "Port" Then
Set my_sketch = sketch.Pictures("Picture 1")
my_sketch.Copy
cal.Cells(25, 1).PasteSpecial
End If
If Cells(8, 27) = "Starboard" Then
Set my_sketch = sketch.Pictures("Picture 2")
my_sketch.Copy
cal.Cells(25, 1).PasteSpecial
End If
End Sub
Currently, the script just pastes in Picture 1, no matter what the contents are in the dropdown. I know the Starboard If statement is working. It appears the clipboard doesn't clear and just copies what is first in the list? Not sure.
As the comments already point out, your problem is that you copy the correct picture but don't delete the old ones.
However, instead of copying (and deleting) the images over and over again, why don't you copy both of them into your sheet once and then simply set the Visible-property to show the image you want and hide the other?
Name the pictures picStarboard and picPort and change your code to
With cal
.Shapes("picStarboard").Visible = (.Cells(8, 27) = "Starboard")
.Shapes("picPort").Visible = (.Cells(8, 27) = "Port")
End With
Here's the scenario. When a row is inserted in the worksheet there's a worksheet_change event that calls a sub that inserts five pairs of buttons on the row that was inserted. When one of those buttons is clicked it runs a sub that issues a MsgBox that displays the TopLeftCell.Row and Column of the button. Multiple rows can be inserted, each with its five sets of buttons (ten in total). Any button in any row can be selected at any time.
What I'm seeing is that after I open the workbook and press one of the buttons, the MsgBox always displays the correct column, but it seems to get "stuck” on one particular row no matter which row the button that I'm clicking is actually in. If I delete the row it is stuck on then it gets "stuck" on a different row (as long as it also contains buttons). But not all of the buttons will be stuck to the same row.
If I copy two adjacent rows with buttons that are “stuck” on the same row to another location, those buttons are still stuck together except on a different row.
It seems like there’s a problem with the button collection. If I save the workbook the problem goes away. If I insert a new row and the Add_Buttons routine runs again, the problem reappears but involving different rows. So my button routine is probably leaving something temporary behind that gets cleared up when I do a save.
Here's the code that builds the buttons.
Public activeWS As Worksheet
Public activeRG As Range
Public Sub Add_Buttons(ByVal myRow As Long)
'Add the five sets of Submit IM and Submit Webins buttons to a new row. The code
'uses named ranges to locate the cells where the buttons should be added so that
'new columns can be added to the spreadsheet without requiring changes to the code.
'The headings must be labeled 'IM#' and 'Webins#'.
Dim i As Long
Dim t As Range
Dim btn As Button
'In each range, place the button below the column label.
Application.ScreenUpdating = False
For i = 1 To 5
Set activeWS = Sheet1
Set activeRG = activeWS.Range("Scan" & i & "_Hdngs")
'The start of the range plus the position of the specified column in
'the range gives the absolute column location to add the button
'Create the Submit IM button
nCol = activeRG.Cells(1, 1).Column + findCol("IM#", activeRG) - 1
Set t = activeWS.Range(Cells(myRow, nCol), Cells(myRow, nCol))
Set btn = activeWS.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "Create_Primary_IM"
.Caption = "Submit IM"
.Name = "BtnIM" & myRow & i
.Font.Size = 10
End With
'Create the Submit Webins button
nCol = activeRG.Cells(1, 1).Column + findCol("Webins#", activeRG) - 1
Set t = activeWS.Range(Cells(myRow, nCol), Cells(myRow, nCol))
Set btn = activeWS.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "Create_Primary_WAS"
.Caption = "Submit Webins"
.Name = "BtnWAS" & myRow & i
.Font.Size = 10
End With
Next i
Application.ScreenUpdating = True
End Sub
Here's the code executed by the buttons:
Public Sub Create_Primary_IM()
MsgBox ("Row, Col of pressed button: " & ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row _
& ", " & ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column)
End Sub
Public Sub Create_Primary_WAS()
MsgBox ("Row, Col of pressed button: " & ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row _
& ", " & ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column)
End Sub
Here's what I believe to be the cause of the problem, its effect on the spreadsheet, and the solution.
The cause was duplicate button names. I had been naming the buttons based on their row and column at the time of creation. The problem is that rows and their buttons could be inserted or deleted anywhere in the sheet. It's not hard to see (except that I didn't see it for a while) that it was possible to insert a row and create its buttons in the same absolute row multiple times. This resulted in buttons with the same .name property.
The effect was that when I clicked one of the duplicate buttons it found the TopLeftCell.Row of the original button with that name, not of the row that the button was actually on. When I saved the file (not closed it) and clicked the same button, it had been renamed to something like 'Button nnn' and the correct row was returned. If I saved the file and re-opened it, the duplicate button name condition was still present. So Excel was replacing duplicate names in that collection when I saved the file, but not committing those changes when I closed the file.
The quickest solution was the easiest as well. I let Excel do the naming. I don't really need the buttons to have names. All I need is the row number. Another solution would be to generate a unique name, but what's the point if that's what Excel is going to do for me anyway?
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
In Excel I'm attempting to extract the data from the textbox that I've dynamically created within the frame. As seen in the code below, the textbox in which the names are gogo1, gogo2 and gogo3 respectively have been created. I would like the information entered into these textboxes to be pasted onto sheet1 when the okay button is pressed. However, I cannot seem to pull any data that was entered into these textboxes and sheet1 remains blank after the okay button is clicked.
Private Sub showCOL_Click()
Dim number As Integer
Dim gogo(1 To 3) As String
For number = 1 To 3
Set first = UserForm2.Frame1.Controls.Add("forms.textbox.1")
With first
.Name = "gogo" & number
.Width = 30
.Height = 20
.Left = 36
.Top = 20 * number
End With
Next number
End Sub`
Private Sub ColnProceed_Click()
If UserForm2.Frame1.Name = "gogo2" Then
MsgBox gogo2.Value
End If
It looks like you are setting up three text boxes, but then checking the name of the frame that contains them in your click handling function. I believe you want to check if the name of the TextBox is "gogo2", not the Frame that groups them.
For now, if you just want to test to see what the values are in the 2nd text box, use:
MsgBox (Me.Controls("gogo2").Value)