Hiding Rows with Excel 2013 - vba

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. :)

Related

How can i keep the selected tables cells, selected after i run the macro?

When i run the below mention macro to reverse the selected table cells words, the macro deselect the selected cells after its first run. I want the selected cells selected after this macro run so that i can call the second macro on the same selection.
Private Sub CommandButton1_Click()
Dim rng As Word.Range
Dim cl As Word.Cell
Dim i As Integer, iRng As Word.Range
Dim oWords As Words
Dim oWord As Range
If Selection.Information(wdWithInTable) = True Then
For Each cl In Selection.Cells
Set rng = cl.Range
rng.MoveEnd Word.WdUnits.wdCharacter, Count:=-1
For i = 1 To rng.Words.Count
Set iRng = rng.Words(i)
'rng.Select
Set oWord = iRng
Do While oWord.Characters.Last.Text = " "
Call oWord.MoveEnd(WdUnits.wdCharacter, -1)
Loop
Debug.Print "'" & oWord.Text & "'"
oWord.Text = StrReverse(oWord.Text)
Debug.Print Selection.Text
Next i
Next cl
End If
End Sub
Sub Align()
'Selection.RtlPara
Selection.LtrPara
End Sub
Private Sub CommandButton2_Click()
Call Align
Call CommandButton1_Click
Call Comma_Remove
Call CommandButton1_Click
End Sub
Sub Comma_Remove()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ","
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
You can see the attached Pic for more clearification
Do you need to run the second macro separately? You could just add at the end of your macro to call the second one.
You probably want to pass the selection to the second macro something like this:
** EDIT: added a bit more clarity (i hope) **
Sub firstMacro(selection)
'' Do stuff with Selection
Debug.Print "This is the first macro and address of selection is: " & selection.Address
End Sub
Sub secondMacro(selection)
'' Do more stuff with Selection
Debug.Print "This is the second macro and address of selection is: " & selection.Address
End Sub
Private Sub CommandButton1_Click()
Call firstMacro(selection)
Call secondMacro(selection)
End Sub
Private Sub CommandButton2_Click(selection) '<--- THIS IS WRONG
End Sub

Union Error Message on Excel

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

Compiler error on if statement

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

How can I improve performance in an Excel VBA For loop with nested If loop?

This is my first post, so if I need to make any changes, please let me know.
I've found a few examples of ways to optimize loops, but I cannot seem to apply any of them effectively to my code. What I'm trying to do is loop through about 170 cells in a single column, and hide or show the entire row based on whether the cell value is 0 or not.
I want the code to run each time I activate certain sheets. Right now this piece of code is taking about 4 seconds to run. It seems like it should be much faster than that! That's why I'm here for help.
Here is the code I'm using (FormatSheet returns a BOOLEAN where True means that it is okay to perform this code on this sheet and False means to skip performing this code on this sheet:
Private Sub mobjWb_SheetActivate(ByVal Sh As Object)
Dim r As Long
Dim z As Long
Dim varray As Variant
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
If Not FormatSheet(Sh) Then
Exit Sub
End If
Set varray = Range("$F$1", Cells(Rows.count, "F").End(x1up)).Value
For Each r In varray
z = r.Value
If z = 0 Then
Range("F" & r).EntireRow.Hidden = True
Else
Range("F" & r).EntireRow.Hidden = False
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
With several very slight changes:
Sub qwerty()
Dim r As Range
Dim z As Long, N As Long
Dim varray As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
N = Cells(Rows.Count, "F").End(xlUp).Row
Set varray = Range("F1:F" & N)
For Each r In varray
z = r.Value
If z = 0 Then
r.EntireRow.Hidden = True
Else
r.EntireRow.Hidden = False
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
run quite rapidly
One thing that may speed up it a little bit.. I would not use z variable. You can do the same with existing r.
For Each r In varray
If r.Value = 0 Then
Range("F" & r).EntireRow.Hidden = True
Else
Range("F" & r).EntireRow.Hidden = False
End If
Next r
I think the quickest way could be to use autofilter. Set the autofilter with values <> 0 and voilĂ !

Combining multiple Worksheet_Change macros

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