I want to click a cell and run a macro to make border if the cell doesn't have it, and if the cell has the border it will erase the border. but I can't do it when cell is merged.
This code is only working for normal cell, can't run if I merge L11 and L12 :
If Not Intersect(Target, Range("L11")) Is Nothing Then
If ActiveSheet.Range("L11").Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And ActiveSheet.Range("L11").Borders(xlEdgeTop).LineStyle <> xlLineStyleNone Then
'if has border erase it.
ActiveSheet.Range("L11").Borders.LineStyle = xlNone
Else
'if doesn't have border create it.
ActiveSheet.Range("L11").Borders.LineStyle = xlContinuous
End If
I try to use same code and change the range but it doesn't work for detect when clicking and for create a border for merge cell.
If Intersect(Target, Range("$M$11:$N$11")) Is Nothing Then
can someone please give me solution for this problem.
Thank you.
I got something working using the Worksheet_SelectionChange event:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And
Target.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone Then
'if has border erase it.
Target.Borders.LineStyle = xlNone
Else
'if doesn't have border create it.
Target.Borders.LineStyle = xlContinuous
End If
End Sub
When you click on a merged cell, it thinks the range is the top-left cell. In my code, the merged cell is just passed as the "Target", which gives you the reference you need.
If you want to limit this to only some cells, you can filter it by addresses. The
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'//Filter to limit behavior to cell we want:
If InStr(1, Target.AddressLocal, "$L$11") Then '//for a merged cell, .AddressLocal looks something like $L$11:$L$12
If Target.Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone And
Target.Borders(xlEdgeTop).LineStyle <> xlLineStyleNone Then
'if has border erase it.
Target.Borders.LineStyle = xlNone
Else
'if doesn't have border create it.
Target.Borders.LineStyle = xlContinuous
End If
End If
End Sub
Because a merged cell has a .AddressLocal in the form of $TopLeftCell:$BottomRightCell, you can filter on the address of the top-left cell to determine which ones get this treatment.
Using the most of your code, a simple one-line does the trick for me:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("L11")) Is Nothing Then Range("L11").MergeArea.Borders.LineStyle = (Range("L11").MergeArea.Borders.LineStyle = 1) + 1
End Sub
You just missed Range.MergeArea ;)
Related
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
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 these sheets Sheet1 and another which is Sheet2.
Sheet1 gets its values (including color of the cell) from Sheet2.
I have this block of code to check for the active cell color in Sheet2 and then change the color of the same cell in Sheet1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Interior.Color = 5296274 Then
Worksheets("ALL BRANDS").Range(Target.Address(False, False)).Interior.Color = 5296274
Else
Worksheets("ALL BRANDS").Range(Target.Address(False, False)).Interior.Color = ActiveSheet.Range(Target.Address(False, False)).Interior.Color
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Interior.Color = 5296274 Then
Worksheets("ALL BRANDS").Range(Target.Address(False, False)).Interior.Color = 5296274
Else
Worksheets("ALL BRANDS").Range(Target.Address(False, False)).Interior.Color = ActiveSheet.Range(Target.Address(False, False)).Interior.Color
End If
End Sub
The problem is when I select multiple cells at a time in Sheet2
it colors the referenced cell in Sheet1 to
You need to collect the Interior.Color property of each cell individually.
When a Range object consists of multiple cells, a few properties (like Value and Formula) will return an array of values. Many properties, including Interior.Color, will not. In the case of Interior.Color, if ALL the cells in the range have the same background color, you will get the correct value. If even one cell has a different color, the property cannot give you a single correct answer, and simply returns 0 (black).
As a side note, your If statement isn't doing anything useful as written. I'll assume you want to copy any occurring color for the sample below. If you only want to copy that certain shade of green, keep your If but drop the Else.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
With Worksheets("ALL BRANDS")
For Each c In Target
.Range(c.Address).Interior.Color = c.Interior.Color
Next c
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
With Worksheets("ALL BRANDS")
For Each c In Target
.Range(c.Address).Interior.Color = c.Interior.Color
Next c
End With
End Sub
Really, you should move that code into a function and call it from each event instead of rewriting and maintaining the code in multiple places.
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?
Having some issues with user form and setting the initial values, what I'm trying to run is the following:
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = UserForm1.colorcodeinit.Value Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub
However, when I try to run it's not registering for the initial color I'm setting, the following works just fine:
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = -4142 Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub
Thanks for any and all help in advance!
Depending upon how your colorcodeinit control value is set, you may need to ensure the form is fully loaded and open before you try to read any values.
I'm reformatting your code to render in SO/Markdown. There doesn't appear to be anything wrong with the code itself, it's probably just when the code is run that is the problem.
Note that ColorIndex may not be reliable across all Excel users.
Block 1:
'Your first code block
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = UserForm1.colorcodeinit.Value Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub
Block 2:
'Your second code block
Sub colorme()
For Each cell In Selection
If cell.Interior.ColorIndex = -4142 Then
With cell
.Interior.ColorIndex = UserForm1.colorcodefin.Value
End With
End If
Next cell
End Sub