I want that the height of the text in a current cell to be automatically adjusted. HEIGHT not width.
I tried this code and it is not working so far.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Worksheets("Lohnbeurteilung").Cells
.EntireRow.AutoFit
.WrapText = True
End With
End Sub
Try (tested):
With Worksheets("Lohnbeurteilung").UsedRange.EntireRow
.WrapText = True
.AutoFit
End With
Note. If you need to autofit only the selected range, you can use With Target.EntireRow in Worksheet_SelectionChange
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 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 ;)
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
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