I am trying to copy Cells B2:B26 from sheet1 to sheet2 B8:B32 with the value and format if a change occurs in sheet 1. The problem is it seems to run in loop for about 10 seconds. I can't see what's wrong. This is my code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Copy_Range
End Sub
Sub Copy_Range()
Sheets("liste d'élèves").Range("B2:B26").Copy
With Sheets("Feuil1").Range("B8:B32").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteAll
End With
Application.CutCopyMode = False
End Sub
You need to disable events. Also, I highly recommend limiting the scope of your Worksheet_SelectionChange. Do you really want any change to trigger the macro? Maybe you are looking in a change within a specific region. If so, specify that region and run the macro when the selection change overlaps (Intersects) with the specified region.
Sub Copy_Range()
Application.EnableEvents = False <--- Off
Sheets("liste d'élèves").Range("B2:B26").Copy
With Sheets("Feuil1").Range("B8:B32").End(xlToLeft).Offset(, 1)
.PasteSpecial xlPasteAll
End With
Application.EnableEvents = True <--- On
End Sub
Related
I have simple macros for clearing cells on "Sheet1", which have drop down lists.
Sub reset1()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
Range("D6:E7").ClearContents
End Sub
Sub reset2()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
End Sub
Then I call these macros on "Sheet1" if the cell values change
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$4" Then
Call reset1
End If
If Target.Address = "$D$6" Then
Call reset2
End If
End Sub
This code is written on the "Sheet1".
Normally it works but sometimes reset1() doesn't work.
I should then save and reopen the excel or run the macro manually.
Should I better modify some codes?
First problem is that with Range("D20:E21") it is not clear in which worksheet that range should be. Always specify the worksheet like Worksheets("Sheet1").Range("D20:E21").
Second problem is that if you .ClearContents in a Worksheet_Change event this is a cell change and triggers another Worksheet_Change event and so on. So it is recommended to disable events Application.EnableEvents = False before changing cells in Worksheet_Change event.
Third problem is that if you test Target.Address = "$D$4" and you copy paste a range where D4 is included your code will not run even if your cell D4 changed. Therefore you always need to work with Intersect.
Option Explicit
Sub Reset1(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9,D6:E7").ClearContents
' alternative:
' Union(ws.Range("D20:E21"), ws.Range("D8:E9"), ws.Range("D6:E7")).ClearContents
End Sub
Sub Reset2(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9").ClearContents
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Goto ENABLE_EVENTS ' in any case an error happens make sure events are enabeld again
If Not Intersect(Target, Me.Range("D4")) Is Nothing Then
Reset1 Me ' here we tell Reset1 to take `Me` as worksheet. Me refers to the worksheet `Target` is in.
End If
If Not Intersect(Target, Me.Range("D6")) Is Nothing Then
Reset2 Me
End If
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number Then
Err.Raise Err.Number
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
Hej,
I've created a small VBA code to dynamically rename a worksheet.
It's working perfectly when the cell is just manually typed.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C9")) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("C9")
End If
End Sub
But then as soon as I will put a formula concatenating 2 cells values within C9 cell it will not update it automatically.
To make it work I need to enter the cell and type ENTER again and it works.
I have to do same manipulation each time I change a value in on of the 2 cell concatenated.
THANKS for your help guys
You need to capture a different event:
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
ActiveSheet.Name = ActiveSheet.Range("C9")
Application.EnableEvents = True
End Sub
NOTE:
We disable events during the name change in case the worksheet contains a formula referencing the tab-name.
this should work:
replace
ActiveSheet.Name = ActiveSheet.Range("C9")
by
ActiveSheet.Name = ActiveSheet.Range("C9").Value
This is an alternate answer if someone still wants to execute this on worksheet change event
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim formulacell As Range
Set formulacell = Range("C9")
Set formulacell = Application.Union(formulacell, formulacell.Precedents)
If Not Intersect(Target, formulacell) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("C9").Value
End If
Application.EnableEvents = True
End Sub
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
Update to code & question:
The current code in the module for this sheet is as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B2")) Is Nothing Then
Application.Run "MonthlyRead"
End If
End Sub
Sub MPrintAll()
Dim c As String
Dim MonthlyList As Range
Set MonthlyList = Worksheets("Monthly").Range("MonthlyList").Cells
For Each cell In MonthlyList
Range("b2").Value = cell.Value
ActiveWorkbook.Worksheets("Monthly").PrintOut
Next cell
End Sub
I've been stepping through the code, to try to identify where the problems occur. When I press F8 after "Range("b2").Value = cell.Value" it immediately goes to the first line of code for the sheet, completely skipping the Print command. Also, it deletes the first value in the named range, instead of copy-pasting it to cell B2.
For reference, here's the code in Module1 called by the first routine above:
Sub MonthlyRead()
Call MEFTPS
Call MUCT6
End Sub
Sub MEFTPS()
If Range("a2").Value = "EFTPS Package" Then
Call MShow
Else: Call MHide
End If
End Sub
Sub MHide()
Rows("20:20").Select
Selection.EntireRow.Hidden = True
Rows("31:31").Select
Selection.EntireRow.Hidden = True
Rows("42:42").Select
Selection.EntireRow.Hidden = True
Rows("53:53").Select
Selection.EntireRow.Hidden = True
Range("B2").Select
End Sub
Sub MShow()
Rows("20:20").Select
Selection.EntireRow.Hidden = False
Rows("31:31").Select
Selection.EntireRow.Hidden = False
Rows("42:42").Select
Selection.EntireRow.Hidden = False
Rows("53:53").Select
Selection.EntireRow.Hidden = False
Range("B2").Select
End Sub
Sub MUCT6()
If Range("g3").Value = "Y" Then
Call UCT6MShow
Else: Call UCT6MHide
End If
End Sub
Sub UCT6MHide()
Rows("19:19").Select
Selection.EntireRow.Hidden = True
Rows("30:30").Select
Selection.EntireRow.Hidden = True
Rows("41:41").Select
Selection.EntireRow.Hidden = True
Rows("52:52").Select
Selection.EntireRow.Hidden = True
Range("B2").Select
End Sub
Sub UCT6MShow()
Rows("19:19").Select
Selection.EntireRow.Hidden = False
Rows("30:30").Select
Selection.EntireRow.Hidden = False
Rows("41:41").Select
Selection.EntireRow.Hidden = False
Rows("52:52").Select
Selection.EntireRow.Hidden = False
Range("B2").Select
End Sub
I'm working with a dynamic worksheet that populates an individualized payment schedule, based on a selection from a data validation drop-list at the top of the page. There are approximately 300 options in the drop-list. These schedules are then printed, to verify information obtained from 2 other programs, all of which must be printed, copied, scanned, packed, and mailed in a single day.
I'm looking for VBA code that can select each client name from the drop-list in order, from the beginning to the end of the list. The list is populated from a named range on another sheet, named "QtrlyList."
I have some very simple code, that doesn't work.
Sub PrintAll()
For Each cell In QtrlyList
Worksheets("Normal").PrintOut
Next cell
End Sub
Whenever I try to run the code, I get a "Type Mismatch" error. I'm fairly certain this is coming from "cell" or "QtrlyList." I'm just not sure how to fix it.
Something like this might work for you (untested)
Sub PrintAll()
Dim wb as Workbook, cell as Range
Set Wb = ActiveWorkbook 'or ThisWorkBook if the code is in your reporting workbook
For Each cell In wb.Sheets("SheetNameHere").Range("QtrlyList").Cells
With wb.Worksheets("Normal")
'you want to set the value of whichever cell has the drop-down
.Range("D2")).value=cell.Value
DoEvents 'allow sheet to pick up changed value
.PrintOut
End with
Next cell
End Sub