Simplify Code

H

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
656
Hi - I have this code in the sheet tab and it executes on a worksheet change. I'm assuming there is a much easier way to do this? Sheets are labeled by their codenames.
Thanks!

Code: 
If Not Intersect(Target, Range("A3")) Is Nothing Then    Rows.Hidden = False
    Select Case Target.Value
        Case 1
            Range("41:164").EntireRow.Hidden = True
            Range("220:259").EntireRow.Hidden = True
            Range("A41") = 2
            Range("A43").ClearContents
            Range("A103") = 3
            Range("A105").ClearContents
            Range("B43:G92").ClearContents
            Range("B105:G154").ClearContents
            Range("F95:G95").ClearContents
            Range("F97:G99").ClearContents
                                  
            Sheet2.Visible = xlSheetHidden
            Sheet5.Visible = xlSheetHidden
            Sheet7.Visible = xlSheetHidden
            Sheet9.Visible = xlSheetHidden
            Sheet10.Visible = xlSheetHidden
            Sheet13.Visible = xlSheetHidden
            Sheet22.Visible = xlSheetHidden
            Sheet23.Visible = xlSheetHidden
            Sheet24.Visible = xlSheetHidden
            Sheet25.Visible = xlSheetHidden
            Sheet26.Visible = xlSheetHidden
            Sheet27.Visible = xlSheetHidden
        
        Case 2
            Range("102:163").EntireRow.Hidden = True
            Range("240:259").EntireRow.Hidden = True
            Range("A41").ClearContents
            Range("A43") = 1
            Range("A103") = 3
            Range("A105").ClearContents
            Range("B105:G154").ClearContents
            Range("F95:G95").ClearContents
            Range("F97:G99").ClearContents
            
            
            Sheet5.Visible = xlSheetVisible
            Sheet10.Visible = xlSheetVisible
            Sheet13.Visible = xlSheetVisible
            Sheet2.Visible = xlSheetVisible
            Sheet7.Visible = xlSheetVisible
            Sheet9.Visible = xlSheetVisible
                       
            Sheet22.Visible = xlSheetHidden
            Sheet23.Visible = xlSheetHidden
            Sheet24.Visible = xlSheetHidden
            Sheet25.Visible = xlSheetHidden
            Sheet26.Visible = xlSheetHidden
            Sheet27.Visible = xlSheetHidden
            
        Case 3
            Range("41:163").EntireRow.Hidden = False
            Range("220:259").EntireRow.Hidden = False
            Range("A43") = 1
            Range("A105") = 1
            
            
            Sheet5.Visible = xlSheetVisible
            Sheet10.Visible = xlSheetVisible
            Sheet13.Visible = xlSheetVisible
            Sheet2.Visible = xlSheetVisible
            Sheet7.Visible = xlSheetVisible
            Sheet9.Visible = xlSheetVisible
            Sheet22.Visible = xlSheetVisible
            Sheet23.Visible = xlSheetVisible
            Sheet24.Visible = xlSheetVisible
            Sheet25.Visible = xlSheetVisible
            Sheet26.Visible = xlSheetVisible
            Sheet27.Visible = xlSheetVisible
        End Select
End If
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
helpexcel said:
Hi - I have this code in the sheet tab and it executes on a worksheet change. I'm assuming there is a much easier way to do this? Sheets are labeled by their codenames.
Thanks!
Click to expand...
Try
Code: 
Dim Sheet_Array As Variant, X As Long


If Not Intersect(Target, Range("A3")) Is Nothing Then Rows.Hidden = False


    Select Case Target.Value
    
        Case 1
        
            Application.Union(Range("41:164"), Range("220:259")).EntireRow.Hidden = True
            
            Range("A41") = 2
            Range("A103") = 3
            
            Application.Union(Range("A43"), Range("A105"), Range("B43:G92"), _
            Range("B105:G154"), Range("F95:G95"), Range("F97:G99")).ClearContents
                                                                   
            Sheet_Array = Array(sheet2, sheet5, sheet7, sheet9, sheet10, sheet13, sheet22, sheet23, sheet24, sheet25, sheet26, sheet27)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetVeryHidden
                
            Next X
        
        Case 2
            Application.Union(Range("102:163"), Range("240:259")).EntireRow.Hidden = True


            Range("A43") = 1
            Range("A103") = 3
            
            Application.Union(Range("A41"), Range("A105"), Range("B105:G154"), _
            Range("F95:G95"), Range("F97:G99")).ClearContents
            
            Sheet_Array = Array(sheet2, sheet7, sheet9, sheet5, sheet10, sheet13)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetVisible
                
            Next X
                       
                       
            Sheet_Array = Array(sheet22, sheet23, sheet24, sheet25, sheet26, sheet27)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetHidden
                
            Next X
            
        Case 3
            
            Application.Union(Range("41:163"), Range("220:259")).EntireRow.Hidden = False
            
            Range("A43") = 1
            Range("A105") = 1
            
            Sheet_Array = Array(sheet2, sheet7, sheet9, sheet5, sheet10, sheet13, _
            sheet22, sheet23, sheet24, sheet25, sheet26, sheet27)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetVisible
                
            Next X
            
        End Select
        
End If
 
Upvote 0
@MoshiM, you don't need to use Application.Union to clear contents you can refer directly to the range i.e.

Code: 
Application.Union(Range("A41"), Range("A105"), Range("B105:G154"), _
            Range("F95:G95"), Range("F97:G99")).ClearContents


can be written as just

Code: 
 Range("A41,A105,B105:G154,F95:G95,F97:G99").ClearContents


and the same with hiding the rows

Code: 
Range("102:163,240:259").EntireRow.Hidden = True

instead of

Code: 
Application.Union(Range("102:163"), Range("240:259")).EntireRow.Hidden = True
 
Upvote 0
Thanks!! I'm getting a run-time error '28': Out of Stack Space and the debug highlights this part of the code.
Code: 
Range("A41, A105, B105:G154,F95:G95, F97:G99").ClearContents
 
Upvote 0
@helpexcel

That line works fine on my end. Here's the adjusted code just in case.
Code: 
Dim Sheet_Array As Variant, X As Long


If Not Intersect(Target, Range("A3")) Is Nothing Then Rows.Hidden = False


    Select Case Target.Value
    
        Case 1
        
            Range("41:164,220:259").EntireRow.Hidden = True
            
            Range("A41") = 2
            Range("A103") = 3
            
            Range("A43, A105, B43:G92,B105:G154, F95:G95, F97:G99").ClearContents
                                                                   
            Sheet_Array = Array(Sheet2, Sheet5, Sheet7, Sheet9, sheet10, Sheet13, Sheet22, Sheet23, Sheet24, Sheet25, Sheet26, Sheet27)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetVeryHidden
                
            Next X
        
        Case 2
        
            Range("102:163,240:259").EntireRow.Hidden = True


            Range("A43") = 1
            Range("A103") = 3
            
            Range("A41, A105, B105:G154,F95:G95, F97:G99").ClearContents
            
            Sheet_Array = Array(Sheet2, Sheet7, Sheet9, Sheet5, sheet10, Sheet13)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetVisible
                
            Next X
                                          
            Sheet_Array = Array(Sheet22, Sheet23, Sheet24, Sheet25, Sheet26, Sheet27)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetHidden
                
            Next X
            
        Case 3
            
            Range("41:163, 220:259").EntireRow.Hidden = False
            
            Range("A43") = 1
            Range("A105") = 1
            
            Sheet_Array = Array(Sheet2, Sheet7, Sheet9, Sheet5, sheet10, Sheet13, _
            Sheet22, Sheet23, Sheet24, Sheet25, Sheet26, Sheet27)
            
            For X = LBound(Sheet_Array) To UBound(Sheet_Array)
            
                Sheet_Array(X).Visible = xlSheetVisible
                
            Next X
            
        End Select
        
End If
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Simplify VBA code
Replies
2
Views
432
kevin9999
K
M
  • Question Question
VBA Sorting Column Issue
Replies
0
Views
469
mrstats_2288
M
PuntingJawa
  • Question Question
VBA Code not auto dating as intended anymore
Replies
2
Views
686
PuntingJawa
PuntingJawa
sharky12345
  • Question Question
Hide button on custom ribbon
Replies
7
Views
4K
My Aswer Is This
My Aswer Is This
A
  • Question Question
VBA Macro Problem
2
Replies
11
Views
2K
Andy0311
A

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top