I want to showing a shape (scrollbar) based on just selecting a specified cell.
I wrote below code but it doesn't work:
If Range("A1").Select Then
ActiveSheet.Shapes("ScrollBar_1").Visible = True
End If
and also the Shape should be hide after Deselecting the cell.
Any idea is welcome.
Thanks
This should do it and must be put in the worksheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then 'Change A1 by the cell you want
ActiveSheet.Shapes("ScrollBar_1").Visible = True
Else
ActiveSheet.Shapes("ScrollBar_1").Visible = False
End If
End Sub
Related
I am trying to write a Macro that updates 4 Cell if the User select "Mailing" From Cell A1. If the User selects "Mailing" in A1, then Automatically update A2,A3,A4, and A5 to Value in B1. If the User selects something other than "Mailing", Then all four cells should be blank and the user should be able to type in any value. Any help is appreciated. Thanks
I have gotten this far, but VBA is not my thing:
Sub test()
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" And Target.Value = "Mailing" Then
Range("A2:A4").Value = "B1"
End If
End Sub
As the others have mentioned, you just need to put it to Sub Worksheet_Change. Note that if you are "typing" the word into cell A1, you will actually be in A2 after the "Enter".
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value = "Mailing" Then
Range("A2:A4").Value = "B1"
End If
End Sub
The problem is you are trying to change the value of some of the cells in your code, so the code should run itself. You need to turn off events before changing the cell values and then turn it back on:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" And Target.Value = "Mailing" Then
Application.EnableEvents = False
Range("A2:A4").Value = "B1"
Application.EnableEvents = True
End If
End Sub
I want a macro so that when you enter a 0 into a particular cell/range of cells that it clears the cell.
I wrote a simple macro like this
Sub RemoveZeros()
'to remove 0 values that may be a result of a formula or direct entry.
For Each cell In Range("A1:D20")
If cell.Value = "0" Then cell.Clear
Next
End Sub
However, I have to run this after I have entered my values for it to clear. I would like the cell to clear if a 0 is entered. How do I do this?
I found a solution
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Value = 0 Then Target.ClearContents
Application.EnableEvents = True
End Sub
Thanks
I have data in column "AK" and a button in Column "AL"; there are several hundred rows and there is only one macro for all buttons as it uses relative references based on the row it is in.
I want the button to only be visible when there is data in the adjacent cell. The following pseudo-code explains what I am trying to achieve:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 37 Then
If Target.Value = 0 Then
Shapes(Target.offset(0, 1)).Visible = False
Else
Shapes(Target.offset(0, 1)).Visible = True
End If
End If
End Sub
The reason for doing this is that the value in AK is calculated based on other values and only displays once all mandatory fields have been completed. The button should only be available for an automation task once all details are complete. What real code would make this work without having to call each button out individually?
I'm not sure if you can directly reference a shape by its location on the sheet.
This code will look at each shape until it finds the one to the right of the cell you've just changed, it will then change the visibility based on the contents of the cell.
(Target.Value <> "") returns TRUE/FALSE.
This will only work if your buttons are placed in the correct cell (slightly too high and it will return the cell above).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets("Sheet1").Shapes
If shp.TopLeftCell.Address = Target.Offset(, 1).Address Then
shp.Visible = (Target.Value <> "")
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
End Sub
Edit:
I've updated the code so it checks that only a single cell has been changed and then looks at each dependent cell of the cell that was changed.
This will probably muck up if the dependent cell is on another sheet though.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rUpdated As Range
Dim shp As Shape
Dim rCell As Range
If Target.Cells.Count = 1 Then
'Hopefully someone will have better code than On Error....
On Error Resume Next
Set rUpdated = Range(Target.Dependents.Address)
On Error GoTo 0
If Not rUpdated Is Nothing Then
'Look at each dependent cell in rUpdated.
For Each rCell In rUpdated
'Look at each shape in the sheet and cross-reference with rCell.
For Each shp In Target.Parent.Shapes
If shp.TopLeftCell.Address = rCell.Offset(, 1).Address Then
shp.Visible = (Target.Value = 0)
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
Next rCell
End If
End If
End Sub
NB: I got the idea for checking the dependent cell from here: How can I run a VBA code each time a cell get is value changed by a formula?
I'm using this current code to update a pivot table filter based on a cell value (E1) within the same sheet. What i would like to do is to update a filter based on a cell in a sheet named summary. If I set the filed in the current filed equal to the cell in the summary I need to press f2 and enter otherwise it won't work. I'm sure a little bit of tweaking and my code could work for it.
Any tips?
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Range("E1")
If Target Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Sheets("Tech Pivot Table").PivotTables("PivotTable2").PivotCache.Refresh
With Me.PivotTables("PivotTable2")
.PivotCache.Refresh
.PivotFields("Name").CurrentPage = Target.Value
End With
Application.EnableEvents = True
End Sub
I think the problem is you're changing the value the Target variable up front when you should be checking to see if Target = "E1". Try the code below and let me know if it works.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("E1") Then
If Target Is Nothing Then Exit Sub
On Error Resume Next
Application.EnableEvents = False
Sheets("Tech Pivot Table").PivotTables("PivotTable2").PivotCache.Refresh
With Me.PivotTables("PivotTable2")
.PivotCache.Refresh
.PivotFields("Name").CurrentPage = Target.Value
End With
Application.EnableEvents = True
End If
End Sub
I have an Excel like shown below which is a sharedExcel.
Now i should not allow paste option for the rows which have backcolour as GRAY(These are not fixed at runtime any row may get GRAY colour). As it sharedExcel and i can't use the Lock property. Any help wouls be appreciated greatly.
Using a color as a property that is used to check true / false is bad behaviour.
You can get around this by for example adding a column (hidden if needed) with 0 / 1 or TRUE / FALSE which you make accessible by for example a combobox (then you can still adapt the color into gray by clicking this cbb box).
The you can check on a dynamically composed range via a Sheet event on_Change.
The basic syntax for the sheet event:
Private Sub Worksheet_Change(ByVal Target As Range)
'Set range dynamically instead of this hard coded example
If Not Intersect(Target, Thisworkbook.Sheets(1).Range("A1:A10")) Is Nothing Then
'Do something
End If
End Sub
After spending some time on this problem i have coded following lines. It work's fine. Here i have taken another spreadsheet called PasteSheet for coding purpose but i am not showing it to user at any moment.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode Then
SelectedRow = ActiveCell.Row
With Sheets("PasteSheet")
.Activate
.Range("A1").PasteSpecial xlPasteValues
CR = Selection.Rows.Count
End With
Worksheets("ActualSheet").Activate
For k = SelectedRow To (SelectedRow + CR)
If Worksheets("ActualSheet").Cells(k, 30).Interior.Color = RGB(215, 215, 215) Then
Application.EnableEvents = False
MsgBox "Pasting is not allowed here!"
'Clearing data in PasteSheet
Worksheets("PasteSheet").Cells.ClearContents
Worksheets("ActualSheet").Activate
Application.EnableEvents = True
Exit Sub
End If
Next
End If
End Sub