VBA Code - Amend to include more references

tlc53

Active Member
Joined
Jul 26, 2018
Messages
380
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

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.

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,425
Office Version
  1. 365
Platform
  1. Windows
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
 

tlc53

Active Member
Joined
Jul 26, 2018
Messages
380
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
 

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,425
Office Version
  1. 365
Platform
  1. Windows
Just rename the rng i have used to rng1 or something like that. Its just a name for a variable.
 

tlc53

Active Member
Joined
Jul 26, 2018
Messages
380
Thanks for that. Really appreciated!
All works fine now :)
 

Watch MrExcel Video

Forum statistics

Threads
1,133,751
Messages
5,660,720
Members
418,591
Latest member
clayest94

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
Top