Combining similar Private Sub Worksheet Codes (VBA)

ctbanker

New Member
Joined
Aug 26, 2015
Messages
26
Hi All,

I am creating a Finance Assessment template and am trying to capture Cash Inflow Streams. If I select "Cost Savings" in cell B2, the corresponding rows are viewable (image 1), but if I select "N/A" in cell B2, the corresponding rows are hidden (image 2) (and this is exactly what I want it to do for the other dropdowns in B2 through B9). By default, all dropdowns will be N/A and the user will select which streams they want to view in cells B2:B9.

I'm having troubles applying the logic I've applied for "Cost Savings" to the other Cash Flow Streams in one code. Can anyone help with this? Thanks in advance!

In addition to the images, I've included a Mini Sheet here:

Finance Assessment Template_Mr. Excel V2.xlsm
ABCDEFGH
1Cash Inflows StreamsSelect from Dropdown:
2Cost Savings ->Cost Savings
3Employee Efficiencies ->N/A
4Non-Interest Revenue ->N/A
5Incremental Loan/Deposit Balances ->N/A
6Member Growth ->N/A
7Salvage Value (Existing Asset) ->N/A
8Costs Avoided ->N/A
9Foregone Revenues & Cannibalization Impact ->N/A
10
112023202420252026
12Cost Savings Input
13Cost Savings Type$$$$
14Example$ 10,000$ 15,000$ 20,000$ 10,000
15[Input Cost Savings Type]$ -$ -$ -$ -
16[Input Cost Savings Type]$ -$ -$ -
17
18Employee Efficiency Input
19Employee Efficiency TypeExample[Input Employee Efficiency Type][Input Employee Efficiency Type][Input Employee Efficiency Type]
20Hourly Rate$ 78---
21Hours Saved100000
22$ Total$ 7,800$ -$ -$ -
23
24Non-Interest Revenue
25Non-Interest Revenue Type$$$$
26Example$ 10,000$ 15,000$ 20,000$ 10,000
27[Input Interest-Revenue Type]$ -$ -$ -$ -
28[Input Interest-Revenue Type]$ -$ -$ -
Sheet1
Cell Formulas
RangeFormula
C22:F22C22=C20*C21
Cells with Data Validation
CellAllowCriteria
B2ListCost Savings, N/A
B3ListEmployee Efficiencies, N/A
B4ListNon-Interest Revenue, N/A
B5ListIncremental Loan/Deposit Balances, N/A
B6ListMember Growth, N/A
B7ListSalvage Value, N/A
B8ListCosts Avoided, N/A
B9ListForegone Revenues & Cannibalization Impact, N/A


Here is the code:
VBA Code:
Private Sub Worksheet_Change_CostSavings(ByVal Target As Range)
Dim PayType As Range
Set PayType = Range("B2")
If Intersect(Target, PayType) Is Nothing Then Exit Sub

'add as many data sets as required
Dim Rng1 As Range

'add as many options as you require
Dim FindHdg1 As Range

'put your headings in the brackets & add more headings if required
Set FindHdg1 = Cells.Find("Cost Savings Input")

Dim RowsToHide As Range
Set RowsToHide = Range("A12:A16")
'add a case for each option in your drop-down & and add more if required
    Select Case PayType
        Case Is = "N/A"
            Cells.EntireRow.Hidden = False
            RowsToHide.EntireRow.Hidden = True
        
        Case Is = "Cost Savings"
            Cells.EntireRow.Hidden = False
            Set Rng1 = FindHdg1.CurrentRegion
            RowsToHide.EntireRow.Hidden = True
            Rng1.EntireRow.Hidden = False
        
    End Select

    
End Sub
 

Attachments

  • Image 1.PNG
    Image 1.PNG
    40 KB · Views: 6
  • Image 2.PNG
    Image 2.PNG
    50.5 KB · Views: 7

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Hi there...

Try the below...

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PayType As Range
Set PayType = Range("B2")
If Intersect(Target, PayType) Is Nothing Then Exit Sub

'add as many data sets as required
Dim Rng1 As Range

'add as many options as you require
Dim FindHdg1 As Range

'put your headings in the brackets & add more headings if required
Set FindHdg1 = Cells.Find("Cost Savings Input")

Dim RowsToHide As Range
Set RowsToHide = Range("A12:A16")
'add a case for each option in your drop-down & and add more if required
    Select Case PayType
        Case Is = "N/A"
            Cells.EntireRow.Hidden = False
            RowsToHide.EntireRow.Hidden = True
        
        Case Is = "Cost Savings"
            Cells.EntireRow.Hidden = False
            Set Rng1 = FindHdg1.CurrentRegion
            RowsToHide.EntireRow.Hidden = True
            Rng1.EntireRow.Hidden = False
        
    End Select

    
End Sub

Might be because you named the Worksheet change event to

VBA Code:
Private Sub Worksheet_Change_CostSavings(ByVal Target As Range)
 
Upvote 0
Another option. Try the following on a copy of your worksheet.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B2:B9"), Target) Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Range("A12:A59").EntireRow.Hidden = True
        Dim i As Long
        For i = 2 To 8
            If Cells(i, 2).Value <> "N/A" Then Cells(i * 6, 1).Resize(5).EntireRow.Hidden = False
        Next i
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub
 
Upvote 0
Hi there...

Try the below...

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PayType As Range
Set PayType = Range("B2")
If Intersect(Target, PayType) Is Nothing Then Exit Sub

'add as many data sets as required
Dim Rng1 As Range

'add as many options as you require
Dim FindHdg1 As Range

'put your headings in the brackets & add more headings if required
Set FindHdg1 = Cells.Find("Cost Savings Input")

Dim RowsToHide As Range
Set RowsToHide = Range("A12:A16")
'add a case for each option in your drop-down & and add more if required
    Select Case PayType
        Case Is = "N/A"
            Cells.EntireRow.Hidden = False
            RowsToHide.EntireRow.Hidden = True
       
        Case Is = "Cost Savings"
            Cells.EntireRow.Hidden = False
            Set Rng1 = FindHdg1.CurrentRegion
            RowsToHide.EntireRow.Hidden = True
            Rng1.EntireRow.Hidden = False
       
    End Select

   
End Sub

Might be because you named the Worksheet change event to

VBA Code:
Private Sub Worksheet_Change_CostSavings(ByVal Target As Range)
Thanks for your response! This works but only if I update cell B2 - if I update cells B3:B9, it doesn't work for the other dropdowns
 
Upvote 0
You would need to declare them as ranges and use a loop or something similar to get them to work... Currently not at pc but will have a look
 
Upvote 0
Another option. Try the following on a copy of your worksheet.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B2:B9"), Target) Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Range("A12:A59").EntireRow.Hidden = True
        Dim i As Long
        For i = 2 To 8
            If Cells(i, 2).Value <> "N/A" Then Cells(i * 6, 1).Resize(5).EntireRow.Hidden = False
        Next i
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub
Thanks Kevin! This works perfectly - only question I have: if the number of rows is different for each dropdown, e.g. Cost Savings if a total of 5 rows but Employee Efficiencies is a total of 8 rows, would it still work?
 
Upvote 0
The short answer is no. The workaround is to space each 'section' 8 rows apart (or whatever your largest section is) and adjust the code. So assuming 8 is your largest section, put the top rows at rows 12, 20, 28, 36, 44, 52, 60 and 68. Then replace the code with this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B2:B9"), Target) Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Range("A12:A76").EntireRow.Hidden = True
        Dim i As Long
        For i = 2 To 8
            If Cells(i, 2).Value <> "N/A" Then Cells(i * 8 - 4, 1).Resize(8).EntireRow.Hidden = False
        Next i
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub
 
Upvote 0
Hi There

Was just having an idea that I think would assist...

What about creating a Table for your different sections...

1.jpg

You can then maybe decide not to see the Header Row...

2.jpg

So before choosing drop down...

before.jpg

After...

after.jpg

You can then name your table/s accordingly and reference these in the code e.g.

VBA Code:
Set RowsToHide = Range("Cost_Savings_Input")
instead of
VBA Code:
Set RowsToHide = Range("A12:A16")

This way I think would be easy seeing as you can add items to the table and these will always be included when hiding / unhiding... even when you remove rows from the table...
 
Upvote 0
The short answer is no. The workaround is to space each 'section' 8 rows apart (or whatever your largest section is) and adjust the code. So assuming 8 is your largest section, put the top rows at rows 12, 20, 28, 36, 44, 52, 60 and 68. Then replace the code with this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("B2:B9"), Target) Is Nothing Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Range("A12:A76").EntireRow.Hidden = True
        Dim i As Long
        For i = 2 To 8
            If Cells(i, 2).Value <> "N/A" Then Cells(i * 8 - 4, 1).Resize(8).EntireRow.Hidden = False
        Next i
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub
Got it, thank you!
 
Upvote 0
Hi There

Was just having an idea that I think would assist...

What about creating a Table for your different sections...

View attachment 92345

You can then maybe decide not to see the Header Row...

View attachment 92346

So before choosing drop down...

View attachment 92347

After...

View attachment 92348

You can then name your table/s accordingly and reference these in the code e.g.

VBA Code:
Set RowsToHide = Range("Cost_Savings_Input")
instead of
VBA Code:
Set RowsToHide = Range("A12:A16")

This way I think would be easy seeing as you can add items to the table and these will always be included when hiding / unhiding... even when you remove rows from the table...
I like the table idea and something I considered - but this will need to be used in conjunction with Kevin's code right?
 
Upvote 0

Forum statistics

Threads
1,215,110
Messages
6,123,148
Members
449,098
Latest member
Doanvanhieu

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