I am trying to combine multiple worksheet_change macros (see code below). My goal is that whenever the "target" range (a merged, drop-down list cell) is changed, the ranges below (again, merged cells) will clear. I need to do this for when MULTIPLE different cells are changed, hence the multiple worksheet change codes.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("J1:O1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("J2:O3").ClearContents
Range("D15:E15").ClearContents
Range("B16:E16").ClearContents
Range("B17:E19").ClearContents
Range("D20:E20").ClearContents
Range("B21:E21").ClearContents
Range("B22:E24").ClearContents
Range("D25:E25").ClearContents
Range("B26:E26").ClearContents
Range("B27:E29").ClearContents
Range("D30:E30").ClearContents
Range("B31:E31").ClearContents
Range("B32:E34").ClearContents
Range("B3:H14").ClearContents
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("J2:K2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("J3:K3").ClearContents
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("L2:M2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("L3:M3").ClearContents
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("N2:O2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Range("N3:O3").ClearContents
Application.EnableEvents = True
End Sub
The code below is simply your code put together in 1 Sub with multiple If statements. The only change is that the If is now an If Not which will process the code if there is an Intersect and then Exit sub.
The following code will do the trick:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J1:O1")) Is Nothing Then
Application.EnableEvents = False
Range("J2:O3").ClearContents
Range("D15:E15").ClearContents
Range("B16:E16").ClearContents
Range("B17:E19").ClearContents
Range("D20:E20").ClearContents
Range("B21:E21").ClearContents
Range("B22:E24").ClearContents
Range("D25:E25").ClearContents
Range("B26:E26").ClearContents
Range("B27:E29").ClearContents
Range("D30:E30").ClearContents
Range("B31:E31").ClearContents
Range("B32:E34").ClearContents
Range("B3:H14").ClearContents
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Range("J2:K2")) Is Nothing Then
Application.EnableEvents = False
Range("J3:K3").ClearContents
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Range("L2:M2")) Is Nothing Then
Application.EnableEvents = False
Range("L3:M3").ClearContents
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Range("N2:O2")) Is Nothing Then
Application.EnableEvents = False
Range("N3:O3").ClearContents
Application.EnableEvents = True
Exit Sub
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("J1:O1")) Is Nothing Then
Application.EnableEvents = False
Range("J2:O3").ClearContents
Range("D15:E15").ClearContents
Range("B16:E16").ClearContents
Range("B17:E19").ClearContents
Range("D20:E20").ClearContents
Range("B21:E21").ClearContents
Range("B22:E24").ClearContents
Range("D25:E25").ClearContents
Range("B26:E26").ClearContents
Range("B27:E29").ClearContents
Range("D30:E30").ClearContents
Range("B31:E31").ClearContents
Range("B32:E34").ClearContents
Range("B3:H14").ClearContents
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("J2:K2")) Is Nothing Then
Application.EnableEvents = False
Range("J3:K3").ClearContents
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("L2:M2")) Is Nothing Then
Application.EnableEvents = False
Range("L3:M3").ClearContents
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("N2:O2")) Is Nothing Then
Application.EnableEvents = False
Range("N3:O3").ClearContents
Application.EnableEvents = True
End If
End Sub
Related
I am getting an error message that says
run-time error 1004': method 'union' of object'_Global' failed
and it is pointing to the line Set unioned = Union(unioned, c)
any tips?
Option Explicit
Private Sub HideRows_Click()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
End With
'On Error Resume Next
Dim ws As Worksheet
For Each ws In Worksheets
Select Case ws.name
Case "Sheet1", "Sheet2", "Sheet3" 'sheets to exclude
'do nothing
Case Else 'hide rows on these sheets
Dim unioned As Range
Dim c As Range
For Each c In ws.Range("AJ16:AJ153,AJ157:AJ292")
If Len(c.Value2) = 0 Then
If unioned Is Nothing Then
Set unioned = c
Else
Set unioned = Union(unioned, c)
End If
End If
Next c
unioned.EntireRow.Hidden = True
End Select
Next ws
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayStatusBar = True
.EnableEvents = True
End With
End Sub
I am new to coding/scripting. Its a school project, I would have to change the below code to add Application.EnableEvents to the existing code to suppress the Change event in other macros.
I tried to change the code, but I get a compile error else without if. I validated the syntax, it looks OK. What am I doing wrong here? Is my understanding with "IF" statements not correct?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then Call Class8 Else Call Class8User
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then Call Class7 Else Call Class7User
End If
Application.EnableEvents = True
End Sub
I am trying to change the code as below.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call Notify
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call NotifyUser
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call Delta
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call DeltaUser
Application.EnableEvents = True
End If
End If
Application.EnableEvents = True
End Sub
Always indent all your code - then you can easily see where you are missing the end if
Private Sub x(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call notify
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call notifyuser
Application.EnableEvents = True
End If ' <-- This was missing
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then
Application.EnableEvents = False
Call delta
Application.EnableEvents = True
Else
Application.EnableEvents = False
Call deltaUser
Application.EnableEvents = True
End If ' <-- This was missing
End If
Application.EnableEvents = True
End Sub
I have excel worksheet with 2 buttons. First button deactivates ribbon, second activates it. I need to combine both functions into one button.
Code sample:
Private Sub CommandButton1_Click()
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = Not Application.DisplayStatusBar
ActiveWindow.DisplayWorkbookTabs = False
End Sub
Private Sub CommandButton2_Click()
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
ActiveWindow.DisplayWorkbookTabs = True
End Sub
Hope for help.
You need to get the actual visibility state of the ribbon first.
Private Sub cmdToggleRibbon_Click()
Dim isRibbonVisible As Boolean
isRibbonVisible = Application.ExecuteExcel4Macro("Get.ToolBar(7,""Ribbon"")")
If isRibbonVisible Then
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
Else
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
End If
Application.DisplayFormulaBar = Not isRibbonVisible
Application.DisplayStatusBar = Not isRibbonVisible
ActiveWindow.DisplayWorkbookTabs = Not isRibbonVisible
End Sub
I have below codes running through multiple command buttons. Just wanted to know if there is any method to stream line. Each button works in a flow having certain characteristics. I am sure there are ways to cutoff excess junk.
Private Sub CommandButton1_Click()
ActiveSheet.Unprotect "bir#2016"
Range("A17").Select
ActiveCell.FormulaR1C1 = "Research"
Sheets("Questionnaire").Select
Sheets("Questionnaire").Range("A1").Select
Sheets("Analyst Score").Select
Sheets("Questionnaire").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton10_Click()
ActiveWorkbook.Unprotect "bir#2016"
Sheets("Investigation Comments Input").Visible = False
Sheets("Analyst Score").Visible = False
Sheets("Questionnaire").Select
ActiveWorkbook.Protect "bir#2016"
End Sub
Private Sub CommandButton11_Click()
ActiveWorkbook.Unprotect "bir#2016"
Sheets("Report Template").Visible = True
Sheets("Report Template").Select
Sheets("Report Template").Range("B4").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub Commandbutton2_Click()
ActiveSheet.Unprotect "bir#2016"
Range("A17").Select
ActiveCell.FormulaR1C1 = "Quality Check"
Sheets("Questionnaire").Select
Sheets("Questionnaire").Range("A1").Select
Sheets("Analyst Score").Select
Sheets("Questionnaire").Select
Sheets("Questionnaire").Range("W1").Select
ActiveCell.Value = Time
Sheets("Questionnaire").Range("A1").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton3_Click()
ActiveSheet.Unprotect "bir#2016"
Range("A17,B17,B1,C1,B3:B5,B7,H19:I127,O19:O127,K19:K127,L19:L127").Select
Range("H19").Activate
Selection.ClearContents
Sheets("Questionnaire").Select
Sheets("Questionnaire").Range("W1:X1,Z1:AE1").Select
ActiveSheet.Unprotect "bir#2016"
Selection.ClearContents
Sheets("Analyst Score").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton4_Click()
ActiveSheet.Unprotect "bir#2016"
ActiveSheet.Unprotect "bir#2016"
Range("I19:I127").Select
Range("I19").Activate
Selection.ClearContents
Range("N7").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton5_Click()
ActiveSheet.Unprotect "bir#2016"
ActiveWindow.ScrollRow = 9
Range("A19").Select
ActiveWindow.FreezePanes = True
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton6_Click()
ActiveSheet.Unprotect "bir#2016"
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-33
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton7_Click()
ActiveSheet.Unprotect "bir#2016"
ActiveSheet.Unprotect "bir#2016"
Range("H19:H127").Select
Range("H19").Activate
Selection.ClearContents
Range("N7").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton8_Click()
ActiveSheet.Unprotect "bir#2016"
Rows("17:127").Select
Selection.EntireRow.Hidden = True
Range("H5").Select
Range("Z:Z,AA:AA,AB:AB").Select
Range("AB9").Activate
Selection.EntireColumn.Hidden = True
Range("M14").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub CommandButton9_Click()
ActiveSheet.Unprotect "bir#2016"
Rows("17:127").Select
Selection.EntireRow.Hidden = False
Range("H5").Select
Range("Z:Z,AA:AA,AB:AB").Select
Range("AB9").Activate
Selection.EntireColumn.Hidden = False
Range("M14").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub DEWS_Click()
ActiveSheet.Unprotect "bir#2016"
Range("A17").Select
ActiveCell.FormulaR1C1 = "Dews"
Sheets("Questionnaire").Select
Sheets("Questionnaire").Range("W1").Select
ActiveSheet.Unprotect "bir#2016"
ActiveCell.Value = Time
Range("W2").Value = Date
Sheets("Questionnaire").Range("A1").Select
ActiveSheet.Protect "bir#2016"
End Sub
Private Sub Worksheet_Calculate()
If Range("E5").Value < 1 Then Me.Shapes("CommandButton2").Visible = False
If Range("E5").Value > 1 Then Me.Shapes("CommandButton2").Visible = True
End Sub
There a lot of ways to shorten your code:
1) Start off with Kyle's comment and reduce your select statements.
2) If you are looking to visually unclutter your code, make better use of white space.
3) In commandbutton4, commandbutton7, you unprotect the same sheet twice.
Other than the above, there is not much more to do if you need every single one of these buttons. Are you sure you can't combine buttons?
So I am attempting to hide rows in Excel 2013 using VBA based a several different conditions:
If title of section is "Unused" hide section. Each section is a named range to make this easier.
If row is part of the "Cblank" named range hide it.
Now for the hard part -- For each Cell in Range("CNonTest") if C.Value = "" and C.Columns(41).Value = "" Then hide them.
Range("CNonTest") is in Col C the extra column that should be check is Col AQ.
For added difficulty I need this macro to run every time any 1 of 8 different validation boxes changes.
Below is the code I currently have:
Sub CompHide()
With Sheets("Comparison").Cells
.EntireRow.Hidden = False
If Range("C9").Value = "Unused" Then
Range("CMarket1").EntireRow.Hidden = True
End If
If Range("C115").Value = "Unused" Then
Range("CMarket2").EntireRow.Hidden = True
End If
If Range("C221").Value = "Unused" Then
Range("CMarket3").EntireRow.Hidden = True
End If
If Range("C329").Value = "Unused" Then
Range("CMarket4").EntireRow.Hidden = True
End If
If Range("C437").Value = "Unused" Then
Range("CMarket5").EntireRow.Hidden = True
End If
If Range("C545").Value = "Unused" Then
Range("CMarket6").EntireRow.Hidden = True
End If
If Range("C653").Value = "Unused" Then
Range("CMarket7").EntireRow.Hidden = True
End If
If Range("C761").Value = "Unused" Then
Range("CMarket8").EntireRow.Hidden = True
End If
If Range("C869").Value = "Unused" Then
Range("CMarket9").EntireRow.Hidden = True
End If
If Range("C977").Value = "Unused" Then
Range("CMarket10").EntireRow.Hidden = True
End If
For Each C In Range("CNonTest")
If C.Value = "" And C.Columns(41).Value = "" Then
C.EntireRow.Hidden = True
End If
Next
Range("CBlank").EntireRow.Hidden = True
End With
End Sub
Then on the Sheet I have this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A4")) Is Nothing _
Or _
Intersect(Target, Me.Range("D4")) Is Nothing _
Or _
Intersect(Target, Me.Range("G4")) Is Nothing _
Or _
Intersect(Target, Me.Range("K4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AO4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AR4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AU4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AY4")) Is Nothing _
Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
For the Sheet Code I have also tried this to no avail
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("D4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("G4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("K4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AO4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AR4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AU4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AY4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
This code all seems to work fine and when I step through CompHide using F8 it works perfectly. So I am thinking the issue is from the code on the sheet itself. You will see a comment in that code that mentions to prevent endless loop that comment came from some hand me down code not quite sure what it is for but figured based on the comment I would leave it.
When I change a validation box it no longer hides the all the right things only some of them. Luckily I have not seen it hide something it was not suppose to yet. I say no longer because at first this code only looked at the first validation box but now it looks at all 8.
Some adjustments to your event handler:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
On Error GoTo haveError
Set rng = Application.Intersect(Target, Me.Range("A4,D4,G4,K4,AO4,AR4,AU4,AY4"))
If Not rng Is Nothing Then
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
CompHide
Application.EnableEvents = True
End If
Exit Sub
haveError:
'always re-enable events
' (screenupdating setting is not persistent)...
Application.EnableEvents = True
End Sub
and the other part:
Sub CompHide()
Dim sht As Worksheet, C As Range
Set sht = Sheets("Comparison")
sht.Rows.Hidden = False
SetRowVis "C9", "CMarket1"
SetRowVis "C115", "CMarket2"
'...and the rest
For Each C In sht.Range("CNonTest")
If C.Value = "" And C.EntireRow.Columns(43).Value = "" Then
C.EntireRow.Hidden = True
End If
Next
sht.Range("CBlank").EntireRow.Hidden = True
End Sub
'utility sub...
Sub SetRowVis(addr As String, rngName As String)
With Sheets("Comparison")
If .Range(addr).Value = "Unused" Then
.Range(rngName).EntireRow.Hidden = True
End If
End With
End Sub
1st, you have referencing issue on your CompHide Sub.
You need to fully reference all Range object call to the worksheet.
With Sheets("Comparison")
.Cells.EntireRow.Hidden = False
'Notice the dot in front of the Range object
If .Range("C9").Value = "Unused" Then .Range("CMarket1").EntireRow.Hidden = True
'Also notice that I used a one liner IF which I think is applicable for you
'Rest of your code go here
'.
'.
'.
End With
2nd, take a look on Tim's post. He beats me to it. :)