So a multifaceted problem:
I have created a training request sheet that I have now been asked to split into different excel sheets for different requests
Using the VBA below I am able to move 1 option to a new sheet but when try to add an additional condition, by simply reproducing the same vba for each variable, it fails.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
If Target = "Head and Neck" Then
Target.EntireRow.Copy Sheets("HN").Cells(Sheets("HN").Rows.Count, "A").End(xlUp).Offset(1)
Rows(Target.Row).Delete
End If
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Also when the automation works it is deleting the cells that are assigned with the dropdown menu. Is there anyway to create to maintain the dropdown whilst deleting the input data?
Many Thanks
Related
I am trying to creata a VBA that gives me automatic values based on drop down list in a form. The problem is that when I run the macro then it is causing an error and excel stops working. Any help in this case is most welcome.
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("$G$11") = "UD Sheet" Then
Rows("20:25").EntireRow.Hidden = False
Else
Rows("21:25").EntireRow.Hidden = True
End If
If Range("G12").Value = "Flex Tape" Then
Range("B20").Value = "None"
Else
Range("B20").Value = ""
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
First thing first, in your code, no need to put an Exit Sub before the End Sub.
The code will end after that line so this is a redundancy.
The next thing that you need to understand is that the Change Event will keep triggering if you will not disable it explicitly. So it means that when you hide a row on that Sheet, the Change Event will keep on happening since there will be changes that will happen on the Sheet. i.e. (Hiding Rows).
To do that you need to disable the EventsListeners of the application using the Application.EnableEvents = False. So the application can do a single thing based on that first event.
The next thing that you need to keep in mind is to track where the Changes occur and fire your program. Target is a Range Object that will return the Range where the specific change occurs on the Sheet.
In order to do that, you need to validate if you need to trigger the routine based on the target using the Intersect function.
The whole code is as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("G11")) Is Nothing Then
If Range("$G$11") = "UD Sheet" Then
Rows("20:25").EntireRow.Hidden = False
Else
Rows("21:25").EntireRow.Hidden = True
End If
End If
If Not Intersect(Target, Range("G12")) Is Nothing Then
If Range("G12").Value = "Flex Tape" Then
Range("B20").Value = "None"
Else
Range("B20").Value = ""
End If
End If
Application.EnableEvents = True
End Sub
I've got a piece of VBA code for Excel Macros which prevents users to input text in the Russian language and it works, however, it throws out an error when copying/pasting a number of cells. I think that I have to limit what Intersect applies to but not sure what is the right way to do so.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target.Cells, [A1:H1000]) Is Nothing Then Exit Sub
If LCase(Target.Cells) Like "*[а-я]*" Then
With Application
.EnableEvents = False: .Undo: .EnableEvents = True
MsgBox "Please use latin letters only"
End With
End If
End Sub
I know this has been posted as a question numerous times. But I just can't get it working, I've tried numerous methods.
I have code that auto copies specific rows to a new sheet when a specific value is entered into Column B. But this only occurs when assign the marco to a button and manually trigger it. This isn't very efficient when copying over numerous rows. Especially when you're copying over hundreds of rows with only the last few actually changing. I'm hoping this will automatically happen when that value is entered.
So my first sheet is called MASTER and the second sheet is called CON. When Change of Numbers is entered into the MASTER I want to automatically copy these rows into sheet CON.
This code below is situated in The Master Sheet (which is the first). This script is used to hide/unhide specific Columns when values are entered into Column B.
MASTER SHEET
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim t As Range
For Each t In Intersect(Target, Range("B:B"))
Select Case (t.Value)
Case "Change of Numbers"
Columns("B:BP").EntireColumn.Hidden = False
Columns("H:BL").EntireColumn.Hidden = True
'do nothing
End Select
Next t
End If
safe_exit:
Application.EnableEvents = True
End Sub
The following script is situated in sheet CON (which is the second sheet). This script is used to auto-copy the rows where X is entered into Column A in the Master sheet. However I have to assign this macro to a button on this sheet. It then grabs all the designated rows each time the macro is triggered.
CON SHEET
Option Explicit
Sub FilterAndCopy()
Dim sht1 As Worksheet, sht2 As Worksheet
Set sht1 = Sheets("MASTER")
Set sht2 = Sheets("CON")
sht2.UsedRange.ClearContents
With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)
.Cells.EntireColumn.Hidden = False ' unhide columns
If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
.AutoFilter field:=1, Criteria1:="Change of Numbers"
.Range("A:F, BL:BO").Copy Destination:=sht2.Cells(2, "B")
.Parent.AutoFilterMode = False
.Range("H:BK").EntireColumn.Hidden = True ' hide columns
End With
End Sub
But this still doesn't work without manually running the script.
Your code is not watching for any events to take place. The particular event you want is the Worksheet_Change() event, which is what I see in the second code snippet you provided.
So, you can go about this two ways. One, copy and paste the entire code into this event, or two (which is usually preferred) would be to call the sub within the event handler.
However, for the Worksheet to watch for the Change Event, you need to place this into the worksheet's code module. In the VBE, you will see this as Sheet1, Sheet2, etc.
My recommendation, place your Sub FilterAndCopy() in a standard module. Then in Sheet1's code module, add:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
'Test if criteria is met
If Intersect(Target, Columns("A")) Is Nothing Then
Exit Sub
ElseIf Target.Value = "mySpecificValue" Then
Application.EnableEvents = False
FilterAndCopy
Dim t As Range
For Each t In Intersect(Target, Range("a:a"))
Select Case UCase(t.Value)
Case "X"
Columns("B:C").EntireColumn.Hidden = True
Columns("D:E").EntireColumn.Hidden = False
Case "Y"
Columns("B:C").EntireColumn.Hidden = False
Columns("D:E").EntireColumn.Hidden = True
Case Else
'do nothing
End Select
Next t
End If
ErrHandler:
If Err.Number <> 0 Then
Rem: Optional - Error message and/or err recovery
End If
Application.EnableEvents = True
End Sub
If you first sub works exactly as intended all you need to do is Call the sub from your Worksheet_Change event. Just to be clear, as your Worksheet_Change macro is set-up, it will only call if the change is made on Column A
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
On Error GoTo Finalize 'to re-enable the events
FilterAndCopy
Finalize:
Application.EnableEvents = True
End Sub
I want to disable cell editing (direct typing into cell) but want to update that cell through code without protecting worksheet
Does anyone have any idea?
In the worksheet's code module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1:A10"), Target) Is Nothing Then
Application.EnableEvents = False
Target.ClearContents '// Assuming you want to keep it blank
Application.EnableEvents = True
End If
End Sub
Then in your code whenever you want to change a value, just disable events before hand:
'// Will be deleted
Range("A5").Value = "TEST"
'// Will not be deleted
Application.EnableEvents = False
Range("A5").Value = "TEST AGAIN"
Application.EnableEvents = True
I had a similar issue and found a workaround. For whatever reason I couldn't get my macros to run correctly with the sheets protected so what I did is as a code to Pop up a message box for any cells that I didn't want the user to change. Then I added "Application.DisplayAlerts = False" to the beginning of any codes that needed to modify those cells and reset the alerts back to True at the end of those codes.
After some googling I finally found some code where I could prevent users from placing formulas inside cells. It works great, that's until I protected the sheet. Can anyone tell me what I'm doing wrong? I'm really new to VB.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
Range("I39").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
The entire code for my sub is as follows. I need to stop users from pasting in the cells and putting formulas in them.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C26")) Is Nothing Then
Application.CutCopyMode = True
Application.EnableEvents = False
On Error Resume Next
Range("C26").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
Here is a version that facilitates formula checking over a range of cells:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26:I26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If Target.HasFormula Then
Application.EnableEvents = False
Target.ClearContents
MsgBox "formulas not allowed in cell " & Target.Address
Target.Select
Application.EnableEvents = True
End If
End Sub
If you want to allow data entry in cell C26, but not formula entry, then use the Change Event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If rNoFormulas.HasFormula Then
Application.EnableEvents = False
rNoFormulas.ClearContents
MsgBox "formulas not allowed in cell C26"
rNoFormulas.Select
Application.EnableEvents = True
End If
End Sub
If you just want to protect certain cells only, no vba code is need.
follow this step :
Open sheet that contains cells or columns that you want to protect, press ctrl while selecting those cells or column to be protect, then right click, choose format cells, choose protection tab and uncheck the locked option. those cells or column will not be locked although you have protected the sheet. default setting is all cells in the sheets is locked so you must choose which cells you want to unlock while protecting the sheet. you may record a macro if you still want to use vba. hope this help