I am using the following piece of vba inside my Worksheet_Change Sub to autosize a particular column with text entries:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nextTarget As Range
Set nextTarget = Range(Selection.Address) 'store the next range the user selects
If Target.Column = 1 Then
Target.Columns.Select 'autofit requires columns to be selected
Target.Columns.AutoFit
nextTarget.Select
End If
End Sub
The above has the problem that every time you enter in a cell of that column text which is shorter than the other cells, it will shrink the column to fit the target cell, leaving the other cells with text outside. Is there any addition that I could make to solve this?
Use the .EntireColumn method. With this there is no need to Select any cells.
Private Sub Worksheet_Change(ByVal Target As Range)
'added extra error trapping in case something happens where more than 1 column is changed.
If Target.Columns.Count = 1 And Target.Column = 1 Then
Target.EntireColumn.AutoFit
End If
End Sub
Related
Code below is supposed to make cursor 'jump'to a column in range of A10:T10, when column header is selected from drop down menu cell A6.
Sub JumpColumn(Target As Range)
If Target.Cells.Count = 1 And Target.Address = "$a$6" Then
Set Rng = Range("a10:t10").Find(What:=Range("a6").Value, LookIn:=xlValues)
Rng.Activate
End If
End Sub
As it is to run with another worksheet change event (PickName) it has been referred to in this code.
Private Sub Worksheet_Change(ByVal Target As Range)
PickName Target
JumpColumn Target
End Sub
PickName is working but not JumpColumn, what am I doing wrong? Thanks.
I want to restrict entries of values only to the named range. Everything entered outside the named range should be cleared.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Liczby")) Is Nothing Then
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Unfortunately, Excel allows you to fill cells also by executing the Copy/Paste command (mouse, keyboard). My code should clear everything that has been pasted outside the named range. It should only paste partial values that fit into the named range and do not show values pasted outside the named range (clear).
For example, I select a row that contains integers 1, 2, 3, 4 in adjacent cells, and try to paste them two columns to the right. As the named range is only 4 columns width, it should paste values 1 and 2 into the named range, and not show values 3 and 4 as they go beyond the named range.
Try each cells in target (if i understood the problem correctly)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Application.EnableEvents = False
For Each Cel In Target.Cells
If Intersect(Cel, Range("Liczby")) Is Nothing Then
Cel.ClearContents
End If
Next
Application.EnableEvents = True
End Sub
I have this function where anytime a cell inside the specific range changes, calls a function.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
Call fit_text
End If
End Sub
The function fit_text changes the font size of the value of the active cell.
Sub fit_text()
MsgBox ActiveCell.Characters.Count
If ActiveCell.Characters.Count > 100 Then
ActiveCell.Font.Size = 8
Else
ActiveCell.Font.Size = 10
End If
End Sub
PROBLEM: whenever I change the value of a cell where the character count is bigger then 100, the font size remains 10 and the message box that tells the value of the count shows 0, but whenever I run it on vba the message box shows the correct value and changes the font size if the count is bigger then 100. I need it to be automatic. Can´t change the height or the width of the cells
Note that Excel can automatically shrink the font size to fit into the cell. Therefore select your cell, press Ctrl+1 go to the Alignment tab and select Shrink To Fit.
To fix your code:
Don't use ActiveCell. Use Target or the Intersect range instead. The ActiveCell might not be the cell that was changed. And also Target can be multiple cells so you need to loop through all the changed cells and test each cell individually.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Target.Parent.Range("A1:L60"))
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange 'loop through all changed cells
MsgBox Len(Cell.Value)
If Len(Cell.Value) > 100 Then
Cell.Font.Size = 8
Else
Cell.Font.Size = 10
End If
Next Cell
End If
End Sub
ActiveCell is the one active after the Change event. You can pass Target from the event to your method fit_text, so that it will always refer to the changed cells:
Private Sub Worksheet_Change(ByVal target As Range)
If Not Intersect(target, Range("A1:L60")) Is Nothing Then
Call fit_text(target)
End If
End Sub
Sub fit_text(target As Range)
MsgBox ActiveCell.Address(False, False)
MsgBox target.Characters.Count
' If ActiveCell.Characters.Count > 100 Then
' ActiveCell.Font.Size = 8
' Else
' ActiveCell.Font.Size = 10
' End If
If target.Characters.Count > 100 Then
target.Font.Size = 8
Else
target.Font.Size = 10
End If
End Sub
You will also want to include a check for when Target is more than a single cell; in which case you will probably want your procedure to check each cell's content.
The problem is the 'ActiveCell'.
For example when you edit the Cell A1 and press enter, the ActiveCell you are using in fit_text is not A1, but A2.
This however can easily fixed, by just passing the Cell from the Worksheet_Change to fit_text.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:L60")) Is Nothing Then
'Pass the Target to 'fit_text'
Call fit_text(Target)
End If
End Sub
Sub fit_text(Cell)
'Instead of using ActiveCell, use Cell (which is the passed Target)
MsgBox Cell.Characters.Count
If Cell.Characters.Count > 100 Then
Cell.Font.Size = 8
Else
Cell.Font.Size = 10
End If
End Sub
I have a Dynamic Table that changes based on the value of B1.
I want the value of B1 to change by clicking on another cell from another workbook. I'm super new to VBA and don't really know what I'm doing.
What I want is to click on any cell from column E and it will change the value of B1 to equal value of column O.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("E2:E")) Is Nothing Then
Worksheets("Dynamic Table").Range("B1").Value = ActiveCell.Offest(0, 10)
End If
End If
End Sub
My Amateur Code
Do you mean sth like that
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 5 Then
If Target.Cells.CountLarge = 1 Then
Worksheets("Dynamic Table").Range("B1").Value = Target.Offset(, 10).Value
End If
End If
End Sub
I assumed you mean with another workbook just another worksheet.
I need to stop the user from pasting over my validation drop down cell. I have read and tried various solutions, none of which work just right. This code I have checks if the pasted value follows validation rules, but it doesn't work if the entire cell is pasted over my validation cell (it seems that this event fires after the paste, so the validation gets erased together with the previous cell):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Range("D2:F13")
If Not Cell.Validation.Value Then
MsgBox "Value violates validation rule"
Application.Undo
Exit Sub
End If
Next
Ideally the code would check if the value of the cell that's being pasted matches validation dropdown options and only allows to paste the value (not the formatting) into the cell.
Thanks!
You can disable the Cut\Copy in the specific cell:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' TARGET IS YOUR VALIDATION CELL
If Target.Column = 1 And Target.Row = 1 Then
Application.CutCopyMode = False
End If
End Sub
Or more complex you can try to check the clipboard of the user on SelectionChange
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' TARGET IS YOUR VALIDATION CELL
If Target.Column = 1 And Target.Row = 1 Then
Set MyData = New DataObject
MyData.GetFromClipboard
'In MyData.GetText you have the clipboard data in text format
If MyData.GetText <> "what you want" then
'...
End if
End If
End Sub
In this case you must add a reference to Microsoft Forms 2.0 Object Library. You can find it in this path: C:\Windows\System32\FM20.DLL