VBA Code - Amend to include more references

tlc53

tlc53

Active Member
Joined
Jul 26, 2018
Messages
399
Hi there,

Can anyone help me amend this VBA code to include more than one reference (if possible)?

It currently refers only to D12 but I want to add another nine references - D68, D124, D180, D236, D292, D348, D404, D460 and D516.

Thank you!

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address(0, 0) = "D12" Then
    Application.EnableEvents = False
    If Len(Target.Value) = 15 Then Target.Value = Application.Replace(Target.Value, 14, 0, "0")
    Target.Value = Format(Replace(Replace(Target.Value, " ", ""), "-", ""), "@@-@@@@-@@@@@@@-@@@")
    Application.EnableEvents = True
  End If
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Presuming what you have there works for you then you can do this:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, rng2 As Range, c As Range

Set rng = Union(Range("D12"), Range("D68"), Range("D124"), Range("D180"), Range("D236"), Range("D292"), Range("D348"), Range("D404"), Range("D460"), Range("D516"))
Set rng2 = Intersect(Target, rng)

If Not rng2 Is Nothing Then
    For Each c In rng2
        Application.EnableEvents = False
        If Len(c.Value) = 15 Then Target.Value = Application.Replace(c.Value, 14, 0, "0")
        c.Value = Format(Replace(Replace(c.Value, " ", ""), "-", ""), "@@-@@@@-@@@@@@@-@@@")
        Application.EnableEvents = True
    Next
End If

End Sub
 
Upvote 0
Thank you. I didn't think it was relevant to post all the code (because there's a lot of it) but as I already have a "Dim rng As Range", it didn't like this code.
Just on its own though, it does work!
Do you know if there's a way around this? Alternatively, I can copy and paste my code 10x but that seems very long winded.

Thanks!

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 With Application
.ScreenUpdating = False
.EnableEvents = False
End With


  If Target.Address(0, 0) = "D12" Then
    Application.EnableEvents = False
    If Len(Target.Value) = 15 Then Target.Value = Application.Replace(Target.Value, 14, 0, "0")
    Target.Value = Format(Replace(Replace(Target.Value, " ", ""), "-", ""), "@@-@@@@-@@@@@@@-@@@")
    Application.EnableEvents = True
  End If


If Not Intersect(Target, Range("No._Bank_Accounts")) Is Nothing Then


If Target.Cells.CountLarge > 1 Then Exit Sub
Select Case Target.Value




    Case "Please Select"
        Range("26:569").EntireRow.Hidden = True
        
    Case 1
        Range("26:569").EntireRow.Hidden = True
        
    Case 2
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:569").EntireRow.Hidden = True
        
    Case 3
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:569").EntireRow.Hidden = True
        
    Case 4
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:177,194:569").EntireRow.Hidden = True
        
    Case 5
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:177,194:233,250:569").EntireRow.Hidden = True
        
    Case 6
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:177,194:233,250:289,306:569").EntireRow.Hidden = True
        
    Case 7
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:177,194:233,250:289,306:345,362:569").EntireRow.Hidden = True
        
    Case 8
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:177,194:233,250:289,306:345,362:401,418:569").EntireRow.Hidden = True
        
    Case 9
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:177,194:233,250:289,306:345,362:401,418:457,474:569").EntireRow.Hidden = True
        
    Case 10
        Range("26:569").EntireRow.Hidden = False
        Range("26:65,82:121,138:177,194:233,250:289,306:345,362:401,418:457,474:513,530:569").EntireRow.Hidden = True
        
End Select
End If
 
    If Range("Plus_YN_01") = "NO" Then
        Range("26:45").EntireRow.Hidden = True
    Else
        Range("26:33,44:45").EntireRow.Hidden = False
    End If




    If Range("Less_YN_01") = "NO" Then
        Range("46:65").EntireRow.Hidden = True
    Else
        Range("46:53,64:65").EntireRow.Hidden = False
    End If
      
      
    If Range("Plus_YN_02") = "NO" Then
        Range("82:101").EntireRow.Hidden = True
    Else
        Range("82:90,100:101").EntireRow.Hidden = False
    End If




    If Range("Less_YN_02") = "NO" Then
        Range("102:121").EntireRow.Hidden = True
    Else
        Range("102:109,120:121").EntireRow.Hidden = False
    End If
    
    
        If Range("Plus_YN_03") = "NO" Then
        Range("138:157").EntireRow.Hidden = True
    Else
        Range("138:145,156:157").EntireRow.Hidden = False
    End If




    If Range("Less_YN_03") = "NO" Then
        Range("158:177").EntireRow.Hidden = True
    Else
        Range("158:165,176:177").EntireRow.Hidden = False
    End If
        
    
        If Range("Plus_YN_04") = "NO" Then
        Range("194:213").EntireRow.Hidden = True
    Else
        Range("194:201,212:213").EntireRow.Hidden = False
    End If




    If Range("Less_YN_04") = "NO" Then
        Range("214:233").EntireRow.Hidden = True
    Else
        Range("214:221,232:233").EntireRow.Hidden = False
    End If
            
    
        If Range("Plus_YN_04") = "NO" Then
        Range("194:213").EntireRow.Hidden = True
    Else
        Range("194:201,212:213").EntireRow.Hidden = False
    End If




    If Range("Less_YN_04") = "NO" Then
        Range("214:233").EntireRow.Hidden = True
    Else
        Range("214:221,232:233").EntireRow.Hidden = False
    End If
            
    
        If Range("Plus_YN_05") = "NO" Then
        Range("250:269").EntireRow.Hidden = True
    Else
        Range("250:257,268:269").EntireRow.Hidden = False
    End If




    If Range("Less_YN_05") = "NO" Then
        Range("270:289").EntireRow.Hidden = True
    Else
        Range("270:277,288:289").EntireRow.Hidden = False
    End If
    
    
        If Range("Plus_YN_06") = "NO" Then
        Range("306:325").EntireRow.Hidden = True
    Else
        Range("306:313,324:325").EntireRow.Hidden = False
    End If




    If Range("Less_YN_06") = "NO" Then
        Range("326:345").EntireRow.Hidden = True
    Else
        Range("326:333,344:345").EntireRow.Hidden = False
    End If


    
        If Range("Plus_YN_07") = "NO" Then
        Range("362:381").EntireRow.Hidden = True
    Else
        Range("362:369,380:381").EntireRow.Hidden = False
    End If




    If Range("Less_YN_07") = "NO" Then
        Range("382:401").EntireRow.Hidden = True
    Else
        Range("382:389,400:401").EntireRow.Hidden = False
    End If
    
    
        If Range("Plus_YN_08") = "NO" Then
        Range("418:437").EntireRow.Hidden = True
    Else
        Range("418:425,436:437").EntireRow.Hidden = False
    End If




    If Range("Less_YN_08") = "NO" Then
        Range("438:457").EntireRow.Hidden = True
    Else
        Range("438:445,456:457").EntireRow.Hidden = False
    End If
        
    
        If Range("Plus_YN_09") = "NO" Then
        Range("474:493").EntireRow.Hidden = True
    Else
        Range("474:481,492:493").EntireRow.Hidden = False
    End If




    If Range("Less_YN_09") = "NO" Then
        Range("494:513").EntireRow.Hidden = True
    Else
        Range("494:501,512:513").EntireRow.Hidden = False
    End If
        If Range("Plus_YN_10") = "NO" Then
        Range("530:549").EntireRow.Hidden = True
    Else
        Range("530:537,548:549").EntireRow.Hidden = False
    End If
    If Range("Less_YN_10") = "NO" Then
        Range("550:569").EntireRow.Hidden = True
    Else
        Range("550:557,568:569").EntireRow.Hidden = False
    End If
Dim rng As Range
Set rng = Intersect(Target, [B33:B43,B53:B64,B90:B99,B109:B119,B145:B155,B165:B175,B201:B211,B221:B231,B257:B267,B277:B287,B313:B323,B333:B343,B369:B379,B389:B399,B425:B435,B445:B455,B481:B491,B501:B511,B537:B547,B557:B567])
If Not rng Is Nothing Then rng(2, 1).EntireRow.Hidden = False
 
 With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 
Upvote 0
Just rename the rng i have used to rng1 or something like that. Its just a name for a variable.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Adding extra Or value to this VBA code
2
Replies
10
Views
147
MeaclH
M
M
  • Question Question
Add extra line of code to VBA to copy cell value across sheet
Replies
1
Views
76
myall_blues
myall_blues
Rob_010101
  • Solved
Add message box
Replies
4
Views
503
Joe4
Joe4
S
  • Question Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
544
sspatriots
S
S
  • Solved
Need to have Worksheet_Change event include value from another column using structured reference
Replies
4
Views
526
Alex Blakenburg
A

Forum statistics

Threads
1,224,820
Messages
6,181,154
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