How to prevent pasting over validation drop down cell in Excel VBA - excel

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

Related

VBA code to select value from drop down menu on sheet and go to column with same value as header on same sheet - Excel 2010

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.

Remove Validation Rules Row by Row from Sheet Based on Column G Value

Hy Experts, I am using an excel sheet that has multiple columns. Every column has validation rules. I want to remove these validation rules upon selecting any row in the entire sheet. When I select the row then I will put the value in G from drop down menu. on the basis of column G value the entire row validation rules should be cleared. The sheet looks like this.
enter image description here
The code that I am using is as under.
Sub RemoveDV()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Cells.Validation.Delete
Next ws
MsgBox ("All Validation Rules has been removed successfully")
End Sub
it working fine but it delete the entire worksheet. But I want to delete the validation only row that I am working on.
Thanks
Try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address
If Not Intersect(Target, Range("G:G")) Is Nothing And Target.Count = 1 Then
If Target.Value = "The value that will trigger the validation clearing" Then
Target.EntireRow.Validation.Delete
End If
End If
End Sub
This will trigger anytime you change a value in column "G" of the specified sheet and if the new value = the text you want.
EDIT:
Let say you store your values (values that will trigger the script) in a range on the same page you can adapt following code to your needs:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr: Arr = Application.Transpose(Range("$P$1:$P$12").Value) 'Values stored in "P1:P12"
If Not Intersect(Target, Range("G:G")) Is Nothing And Target.Count = 1 Then
If UBound(Filter(Arr, Target.Value)) > -1 Then
Target.EntireRow.Validation.Delete
End If
End If
End Sub

Select first empty cell in specific column when switching between worksheets

I have a single workbook with multiple sheets. Sheet 1 uses cell A1 as a search box to find a specific sheet in the book. The sheets after Sheet 1 are named like this, SO123456 with different numbers following the SO. I have the following code on sheet 1 to open the corresponding sheet from the value typed into A1 of Sheet 1:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
Sheets(Target.Value).Activate
End Sub
When the corresponding sheet is opened, I want to open it to the next empty cell in column A. I have some code on the SOxxxxxx sheets that populates time in Column C when my data is entered in Column A. Here is that code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Columns("A:A")) Is Nothing Then
Target.Offset(0, 2).Value = Now
End If
End Sub
I'm not sure how to make sure the first empty cell in Column A is selected or where the code goes; sheet being opened or where the call is to open the sheet. I tried entering the following code below the Worksheet_Change block with no luck:
Range("A" & Rows.Count).End(xlup).Offset(1).Row
Cells(Rows.Count,1).End(xlup).Offset(1).Row
UsedRange.Rows.Count
I know next to nothing about VBA if you haven't already noticed.
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "A$1” Then Exit Sub
With WorkSheets(Target.Value)
.Activate
.Cells(.Rows.Count,1).End(xlup).Offset(1).Select
End With
End Sub
This should get you to the first empty cell in Column A
rowEmpty = Range("A" & 10000).End(xlup).Row +1
You can replace the number 10000 with a sufficiently large number that ensures there will be no data there. There are alternatives to that, but I think this one is easier to begin with.
With this code, typing a sheet name in cell A1 from sheet1 will activate the sheet you type, and the active cell will be the first one in blank in column A.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub
Sheets(Target.Value).Activate
ActiveSheet.Cells(Sheets(Target.Value).Range("A1").End(xlDown).Row + 1, 1).Select
End Sub

Highlight Current Row Without Deleting Existing Cell Colours

I found the code below, and while it highlights the entire row it also removes the color from any previously colored cell.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Target.Parent.Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire row and column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
End Sub
I would like to highlight the entire row on selection of a cell (that may already be colored), but when I move to a cell in a different row, the previously highlighted row should return to its previous color.
Is there a way to modify the previously selected cells/rows?
Conditional formatting overrides "regular" formatting (without replacing it), so if you don't already have some CF applied it's a convenient way to highlight a row without zapping any existing cell colors.
Here's a very basic example:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Me.Cells.FormatConditions.Delete
With Target.EntireRow.FormatConditions.Add(Type:=xlExpression, _
Formula1:="=TRUE")
.SetFirstPriority
.Interior.Color = 65535
End With
Application.ScreenUpdating = True
End Sub
You will need to store the format and row number somewhere then paste it back upon selecting a new row.
This will store the exiting format and row number before the highlight to the 1,040,000 row on the same sheet.
Then when another row is selected it will check if there is formatting there and replace the row from where it was copied back.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
'test if formatting exist and copy it back to the row just left.
If Cells(1040000, 1) <> "" Then
Rows(1040000).Copy
Rows(Cells(1040000, 1).Value).PasteSpecial Paste:=xlPasteFormats
End If
'Copy formating to store
Rows(Target.Row).Copy
Rows(1040000).PasteSpecial Paste:=xlPasteFormats
Cells(1040000, 1) = Target.Row
With Target
' Highlight the entire row and column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I have created an add-in for this. Download, enable content, and click the install button. The add-in creates three buttons on the View ribbon tab that toggle the highlighting.
Uses Conditional Formatting, so no overriding cell color settings.
All code is in the add-in, so no additional VBA required.
This is what I can come up with:
Public rngPreviousColor As Range
Public lngColor As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not rngPreviousColor Is Nothing Then
rngPreviousColor.Interior.ColorIndex = lngColor
End If
Set rngPreviousColor = Target.EntireRow
lngColor = rngPreviousColor.Interior.ColorIndex
With Target
.EntireRow.Interior.ColorIndex = 8
End With
End Sub
The idea is that the other row is the whole in one color and we save the row as a range rngPreviousColor and the color as lngColor.

Autofit Target cell but only when content is larger

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

Resources