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
Related
I'm trying to create a button with an attached macro that will copy a range with formulas and data, then paste it to the next available column, and finally add one day to one specific cell. The problem I'm having is that I want to do it over and over, with the each new pasted cell adding one date from the previously pasted one. The idea is that I click the button, it pastes the orginal range plus one day added to that specific cell, then I can add data to that new pasted block, then click the button and get a new pasted block with the next specific cell having one day added to it.
So far I have this:
Sub PasteToNextEmptyColumn()
Application.ScreenUpdating = False
Range("A4:C14").Copy
ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteColumnWidths
ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll
Range("E9").Value = DateAdd("d", 1, (Range("E9")))
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I'm a little unsure on what you're trying to accomplish, but if this helps.
With a date you can treat it like a value and just put:
Range("E9") = Range("E9") + 1 ' this will input the date in the same cell E9
Maybe ensure the date is inn DD/MM/YYYY or another recognised format.
It seems as though the pasting is correct, if you wanted the date to be input alongside the new data added that is a little different using the last column formula you've already used.
I have an HMI database dump that lists all available tags and I need to weed out the unused tags. I have separated each tag into its own region to try and make it somewhat easier. I want to see if a tag shows up on a window and/or if it is logged. Sometimes tags will be logged, but not used on a window and vice versa.
I created an if statement to check to find a cell that contains “WINDOWS:” and then copied that cell and all cells to the right of it to the next blank row on Sheet2. I also copied the tag name from the first cell in the area and pasted it to the next sheet. I am trying have the data formatted by the tag name then the associated attributes on the second sheet. I then created something very similar to check for “LOGGED:”.
The problem is that I need to loop through each individual area multiple times for it to search for both Windows and Logged and I am not sure how to do this. I also want to be able to eventually add more keywords to look for in the area after getting the base code worked out. I have tried multiple different nested if and for loops and I can't seem to get my code just right.
I used this as a starting point: Previously Asked Question
Here is my code:
Sub ZoneTest()
Dim Area As Range
Dim cell As Range
Dim lr As Long
Dim lc As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
'Looping through each block
For Each Area In Cells(lr, lc).SpecialCells(xlCellTypeConstants, 2).Areas
'Checking each cell
For Each cell In Area
If InStr(1, cell, "WINDOWS:") Then
Range(cell, cell.End(xlToRight)).Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(2, 0)
Area.End(xlUp).Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(1, 0)
End If
If CBool(InStr(1, cell.Value, "LOGGED:")) Then
If CBool(InStr(1, cell.Offset(0, 1).Value, "Yes")) Then
cell.Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(4, 0)
Area.End(xlToLeft).Copy Sheets("Sheet2").Range("A:A").End(xlUp).Offset(3, 0)
End If
End If
Next cell
Next Area
End Sub
I am also attaching a screenshot of my Database so you can see the formatting I have.
Database Example
What do I need to know?
How do I get the location of the data that a textbox is displaying? How do I know where it is?
What am I doing?
I have some code that loops through i and assigns it a value then pulls the cell value from a sheet based on i....so (i, 2) is simply: Row i from Column 2. This is then displayed in a userform Textbox.
What I want to do?
Add a dbl_click event, so that someone can double click on the textbox and be sent to the sheet/row/column that is being displayed. I have no issue creating the dbl_click event, but my problem appears to be how to get the cell location being displayed?
If it is relevant, this is my code for the loop:
Dim code as String
code = search.Value
For i = 2 To LastRow
If Sheet1.Cells(i, 9).Value = code Then
ssn1.Text = Sheet1.name
hb11.Text = Sheet1.Cells(i, 9).Value
End If
Next i
This is a snippet, as this goes on for awhile, hb11 runs though to hb37 - didn't see any reason to paste it all here.
The problem is, that the loop continues through, across multiple sheets as well, finding all examples of "code" so i keeps changing, after it has written the data to the TextBox - so I can't rely on (i, 9) from the loop.
I have gotten this far in terms of code:
Sub bt11_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If hb11.Value <> ("") Then
Application.Goto Reference:=Sheet1.Range(hb11)
End If
End Sub
However this appears to be relying on the value of hb11, rather than the cell location.
I know this is a dumb question, I know, but I just can't seem to find the answer?
I get the feeling that it lies in:
Dim cell as Range
Then:
Set cell = hb11.something
But I have been through the list, cell/range gives a mismatch, and don't actually exist in the list. There is no 'linked cell' as I thought that might do it...
I am a bit lost.
Profit from using the .Tag property
I'm assuming each of your 27 textboxes refers to exactly one source range address which consists of sheetname, row and column (or column character).
If so you can profit from assigning a combined reference string (e.g. "Sheet22" & "," & i & "," & 9) to a textbox'es ►.Tag property during the initializing loop, e.g. in a comma separated way like perhaps
hb11.Tag = "Sheet22,17,9" ' << i.e. sheet name, row 17, column 9
I think it'll be easy to get all data from there:
Dim src: src = split(hb11,",")
Application.Goto Reference:= _
ThisWorkbook.Worksheets(src(0)).Range(Cells(Val(src(1)), Val(src(2))).Address), Scroll:=True
Too many hours later, I have worked this out.
Thanks to T.M. for the idea about re-writing the data out of a stored place.
Outside of any sub, I created a String - right at the top.
Dim ac1 As String
Inside my loop, I simply gave ac1 the value of i,
For i = 2 To LastRow
If Sheet1.Cells(i, 9).Value = code Then
ssn1.Text = Sheet1.name
hb11.Text = Sheet1.Cells(i, 9).Value
ac1 = i
End If
Next i
This works, because you only run through this loop, IF code exists, since the list is unique, code only exists once. So you only go into the loop once, and when you do, i = the row.
Then using T.M.'s idea, I wrote out:
Application.Goto Reference:=Sheet1.Range("A" & ac1)
This is a range reference that Goto can handle.
The advantage of this method is, because I am searching multiple sheets with multiple Textboxes, I only need ac1 for a whole sheets worth of Textboxes.
Hope this helps someone in the future.
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!
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