I have a Macros enabled workbook(protected sheets).
Users are allowed to provide the inputs to the cells that are unlocked.
The problem here is when users copy paste the data from other applications, it will overwrite the format used on an existing sheet, which is creating a hassle.
Is it possible to keep the format even when users copy/paste?
1) Create custom styles for various formatting used on your sheet and (if possible) name ranges which are "styled"
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("STYLE")).Count = Target.Count Then
Target.Style = "STYLE"
End If
End Sub
This code will check, if changed cells are "inside" of styled range. If all changed cells are inside the styled range - apply the style. If you keep the range naming consistent with style naming you can use a loop to go through.
The following code worked for me. It recognizes if someone pastes into the range of cells, undoes the paste, and repastes matching the destination formatting
If Not Intersect(Target, Range("A1:D12")) Is Nothing Then
If Application.CommandBars("Standard").Controls("&Undo").Enabled = True Then
Dim UndoString As String
UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(UndoString, 5) = "Paste" Then
Application.EnableEvents = False
Application.Undo
Target.Select
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
Application.EnableEvents = True
End If
End If
End If
Related
I have a spreadsheet that is going to be used in a survey.
How can I make the cells only to return "x" regardless of what the survey taker type in.
For instance, if I write a "w" in the cell, it should turn into an "x".
I have come to a point where I think there is an option when I protect the workbook or sheet. Because I can tell from another spreadsheet (which has this function) that it only works if the workbook is protected.
I tried to google it, but it seems as if I don't know the right keywords to find the answer.
Also, I have found a set of Vba code that I fiddle with, but I'm not sure this is correct. I don't want to attach the code as I don't want to confuse any response here.
Thank you for any help provided.
Put this code in the worksheet module and test it out, when you change a cell in column A (1) it will activate,
Where is the worksheet Module?
Copy and paste the code ,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("A1,B1,C1,A4,B4,C4")) Is Nothing Then Exit Sub
Application.EnableEvents = 0
If Target <> "" Then Target = "X"
Application.EnableEvents = 1
End Sub
This should work for you (just change the range to the one you need) :
Option Explicit
Sub worksheet_Change(ByVal Target As Range)
On Error GoTo errorbutler 'error handler - important to have this in case your macro does a booboo
Application.Calculation = xlCalculationManual 'turn off automatic calculation to speed up the macro
Application.EnableEvents = False 'turn off events in order to prevent an endless loop
Dim LR, cell As Range 'Declare your variables
Set LR = Range("A1:b3") ' Select range of cells this macro would apply to
For Each cell In Target 'Loops through the cells that user have changed
If Union(cell, LR).Address = LR.Address Then 'Checks if the changed cell is part of your range
cell.Value="x" 'changes the value of that cell to x
End if
Next cell
Errorexit: 'part of error handling procedure
Application.EnableEvents = True 'Turn autocalc back on
Application.Calculation = xlCalculationAutomatic 'turn events back on
Exit Sub
Errorbutler: 'error handling procedure
Debug.Print Err.Number & vbNewLine & Err.Description
Resume Errorexit
End Sub
Oh yes, and this code should be put into the worksheet module - the same way as Dave has shown you
I have a worksheet which is protected. Only some cells are editable and the user can write into them but cannot change the cell format as usual. If he decides to copy and paste data from another worksheet to mine then the cell formatting of the other worksheet is applied to my cells. I want my cells to be editable in value but their cell format must not be editable at all! How can I do that?
Thanks in advance!
Marco
I used this in order to only paste the values if the user decides to copy and paste in the cells whose format is protected:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Application.CutCopyMode = xlCopy Then
Application.EnableEvents = False
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End If
End Sub
It undoes any pastes into the worksheet and pastes it again (only values, no formatting).
One method would be using the worksheet_change event to see if any of the cells have changed:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("J2").Address Then
'your code
End If
End Sub
Next apply the original formatting to the cells that have changed.
I would like to write some vba code that monitors the OnChange event for a sheet and does some adjustment if text does not fit a cell.
I.e. make the text smaller or wrap etc..
I know a can have Excel to automatically shrink the text and I know how to enable wrap in vba, but...
how do I check in vba whether the text fits in a cell to begin with?
Quick and dirty way which will not require you to check each and every cell.
I use this method to usually show all the data.
Sub Sample()
With Thisworbook.Sheets("Sheet1").Cells
.ColumnWidth = 254.86 '<~~ Max Width
.RowHeight = 409.5 '<~~ Max Height
.EntireRow.AutoFit
.EntireColumn.AutoFit
End With
End Sub
I use this method if I want to wrap the text (If Applicable) and keep the row width constant
Sub Sample()
With Thisworbook.Sheets("Sheet1").Cells
.ColumnWidth = 41.71 '<~~ Keep the column width constant
.RowHeight = 409.5
.EntireRow.AutoFit
End With
End Sub
Note: This is not applicable for merged cells. For that there is a separate method.
I'm using THE "dirty" method - that's only one I know: force AutoFit and check new width/height.
However, we can't grantee that was chosen cell that forced new fit. So I opt by copying cell content to an empty worksheet.
That, of course, cause a lot of other problems, and more workarounds.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Fits(Target) Then
'Notice that Target may have multiple cells!!!
End If
End Sub
Function Fits(ByVal Range As Range) As Boolean
Dim cell As Range, tmp_cell As Range, da As Boolean, su As Boolean
'Stores current state and disables ScreenUpdating and DisplayAlerts
su = Application.ScreenUpdating: Application.ScreenUpdating = False
da = Application.DisplayAlerts: Application.DisplayAlerts = False
'Creates a new worksheet and uses first cell as temporary cell
Set tmp_cell = Range.Worksheet.Parent.Worksheets.Add.Cells(1, 1)
'Assume fits by default
Fits = True
'Enumerate all cells in Range
For Each cell In Range.Cells
'Copy cell to temporary cell
cell.Copy tmp_cell
'Copy cell value to temporary cell, if formula was used
If cell.HasFormula Then tmp_cell.Value = cell.Value
'Checking depends on WrapText
If cell.WrapText Then
'Ensure temporary cell column is equal to original
tmp_cell.ColumnWidth = cell.ColumnWidth
tmp_cell.EntireRow.AutoFit 'Force fitting
If tmp_cell.RowHeight > cell.RowHeight Then 'Cell doesn't fit!
Fits = False
Exit For 'Exit For loop (at least one cell doesn't fit)
End If
Else
tmp_cell.EntireColumn.AutoFit 'Force fitting
If tmp_cell.ColumnWidth > cell.ColumnWidth Then 'Cell doesn't fit!
Fits = False
Exit For 'Exit For loop (at least one cell doesn't fit)
End If
End If
Next
tmp_cell.Worksheet.Delete 'Delete temporary Worksheet
'Restore ScreenUpdating and DisplayAlerts state
Application.DisplayAlerts = da
Application.ScreenUpdating = su
End Function
Has solution got too complex, there may be some problems I didn't preview.
This won't work in read-only workbooks, however, cells in read-only workbooks don't change as well!
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
I have two columns but the codition I would like is to be evaluated from one cell to another.
The first column has cells which have a drop down validation with names, and the second will activate only if a certain name from the adjacent cell is selected.
so far i only found this code but it does not seem to work:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value = "Car" Then
Range("B1").Locked = False
Else
Range("B1").Locked = True
End If
End Sub
I would need this code go from (for example) A1:A10 and B1:B10.
I hope I am making sense. If there is a way to do it without VBA, that would be great.
Thanks for the help.
The Target parameter tells you the range that is being changed.
You need to do something like the following:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A1:A10"), Target)
If rng Is Nothing Then
' Not updating the range we care about
Exit Sub
Else
rng.Offset(0, 1).Locked = ... whatever ...
End If
End Sub
Note that your target range can be more than one cell (e.g. when using copy/paste), so you need to handle and test this case.
Calling Intersect returns you the intersection of the target range and the range you are interested in testing (A1:A10 in this sample).
You can then access the corresponding adjacent cell(s) using .Offset(0,1)
That code snippet works perfectly for me.
Did you place that code in the proper WorkSheet object? It won't work if you just put it into a VBA module. When you are in the Visual Basic Editor, look for a directory on the left side of the screen labeled "Microsoft Excel Objects". In that directory should be a WorkSheet object for every sheet in your file. Double-click on one of these to edit the code for that WorkSheet. This is where your code snippet should go.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1").Value = "Car" Then
Range("B1").Locked = False
Me.Unprotect ("password")
Else
Range("B1").Locked = True
Me.Protect ("password")
End If
End Sub
Use Me.Protect so the .Locked method does something. You should probably unlock every other cell though.