Shorten code possibaly with a loop?

Mick Peters

Board Regular
Joined
May 18, 2015
Messages
93
Hi, Could anyone please help with shortening the below code. I tend to search out how to do something and then when I get it working just repeat the step. Here I have a list of 36 users (Column Z from Cell 3 to 38) and for each user there is a work sheet with the tab name the same as the user name. The tab name changes when the user name is changed in one of the cells. What I am trying to do with the below code is to hide the tabs where there is no user name in the corresponding cell. I started with only a few names and it worked fine and as the range for names expanded I added more lines of code. However this last addition has taken the number over 12 and the 13th one and any after have failed to work. I have seen some code wit loops but not full up on how they work. I am eager to learn so if anyone answering would be kind enough to add any helpful comments so I could solve something like this on my own if the future that would be really great.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If [Z3] <> "" Then
Sheet4.Visible = True
Else
Sheet4.Visible = False
End If
If [Z4] <> "" Then
Sheet5.Visible = True
Else
Sheet5.Visible = False
End If
If [Z5] <> "" Then
Sheet6.Visible = True
Else
Sheet6.Visible = False
End If
If [Z6] <> "" Then
Sheet7.Visible = True
Else
Sheet7.Visible = False
End If
If [Z7] <> "" Then
Sheet8.Visible = True
Else
Sheet8.Visible = False
End If
If [Z8] <> "" Then
Sheet9.Visible = True
Else
Sheet9.Visible = False
End If
If [Z9] <> "" Then
Sheet10.Visible = True
Else
Sheet10.Visible = False
End If
If [Z10] <> "" Then
Sheet11.Visible = True
Else
Sheet11.Visible = False
End If
If [Z11] <> "" Then
Sheet12.Visible = True
Else
Sheet12.Visible = False
End If
If [Z12] <> "" Then
Sheet13.Visible = True
Else
Sheet13.Visible = False
End If
If [Z13] <> "" Then
Sheet14.Visible = True
Else
Sheet14.Visible = False
End If
If [Z14] <> "" Then
Sheet15.Visible = True
Else
Sheet15.Visible = False
End If
If [Z15] <> "" Then
Sheet16.Visible = True
Else
Sheet16.Visible = False
End If
If [Z16] <> "" Then
Sheet17.Visible = True
Else
Sheet17.Visible = False
End If
If [Z17] <> "" Then
Sheet18.Visible = True
Else
Sheet18.Visible = False
End If
If [Z18] <> "" Then
Sheet19.Visible = True
Else
Sheet19.Visible = False
End If
If [Z19] <> "" Then
Sheet20.Visible = True
Else
Sheet20.Visible = False
End If
If [Z20] <> "" Then
Sheet21.Visible = True
Else
Sheet21.Visible = False
End If
If [Z21] <> "" Then
Sheet22.Visible = True
Else
Sheet22.Visible = False
End If
If [Z22] <> "" Then
Sheet23.Visible = True
Else
Sheet23.Visible = False
End If
If [Z23] <> "" Then
Sheet24.Visible = True
Else
Sheet24.Visible = False
End If
If [Z24] <> "" Then
Sheet25.Visible = True
Else
Sheet25.Visible = False
End If
If [Z25] <> "" Then
Sheet26.Visible = True
Else
Sheet26.Visible = False
End If
If [Z26] <> "" Then
Sheet27.Visible = True
Else
Sheet27.Visible = False
End If
If [Z27] <> "" Then
Sheet28.Visible = True
Else
Sheet28.Visible = False
End If
If [Z28] <> "" Then
Sheet29.Visible = True
Else
Sheet29.Visible = False
End If
If [Z29] <> "" Then
Sheet30.Visible = True
Else
Sheet30.Visible = False
End If
If [Z30] <> "" Then
Sheet31.Visible = True
Else
Sheet31.Visible = False
End If
If [Z31] <> "" Then
Sheet32.Visible = True
Else
Sheet32.Visible = False
End If
If [Z32] <> "" Then
Sheet33.Visible = True
Else
Sheet33.Visible = False
End If
If [Z33] <> "" Then
Sheet34.Visible = True
Else
Sheet34.Visible = False
End If
If [Z34] <> "" Then
Sheet35.Visible = True
Else
Sheet35.Visible = False
End If
If [Z35] <> "" Then
Sheet36.Visible = True
Else
Sheet36.Visible = False
End If
End Sub
Thank you in advance,
Mick
 
Not
And for interest heres why. Consider this code:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 26 And Target.Row > 2 Then
    MsgBox "Column and row"
End If

If Not Intersect(Target, Range("Z3:Z100")) Is Nothing Then
    MsgBox "Intersect"
End If

End Sub

Now change a cell in the range, say Z3. You get two message boxes yes? Now try this. Put a 1 in A1 and a 2 in B1. Copy these cells. Now paste them into Y3. Note the message box.

Not sure I get the point. Sure Z3 changes so the script runs.
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
The point is Target.Column isnt going to produce 26 if i change Y3:Z3 simultaneously so the script doesnt run.
 
Upvote 0
So are you putting this same script in all your sheets?
And you said sheet name changes when cell value changes.

I think it would be nice to know what your overall objective is.
And it looks like to me since your using cell change event. Every time you modify any cell value this script will run.

Thank you for your reply.
I have a range where User names are stored on 1 sheet the number of names and who changes almost weekly.
I have a sheet to represent each name and the sheet Tab is the persons name, that is why I am using the sheet code name not the tab name.
So when there are 5 names in the list I want to show 5 sheets (plus the sheet with the list) when there are 10 names I want to show 10 sheets (plus the sheet with the list).
I hope this is clearer,
Thank you,
Mick.
 
Upvote 0
Thank you so much every one.
To clear up a few points.
I have a list of names from Z3 to Z38. I have a corresponding work sheet for each of the cells (cell = Name = Worksheet = Tab).
When a name is added deleted or changed I am trying to get a chain reaction.
1 Add a name in a previously blank cell = Un-hide the sheet corresponding to the cell and name the tab the same as the cell.
2 Remove a name from a cell where a name currently resides(and the worksheet is visible) = Hide the work sheet (it does not need the Worksheet name (TAB) changed as it will be hidden and the name will change if it is made visible again.
3 if a name on the list is changed = Worksheet (TAB) name changes to.
This code from above
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i   As Long
If Target.Column = 26 And Target.Row > 2 Then
  For i = 3 To 36
    If Worksheets(i + 1).Visible <> Cells(i, "Z") <> "" Then
      Worksheets(i + 1).Visible = Not (Worksheets(i + 1).Visible)
    End If
  Next i
End If
End Sub
hides all the works sheets after the first blank cell. so if I have names from Z3 to Z10 and delete the name in Z8 then tabs 8,9 and 10 are hidden. I would only want 8 to be hidden and 9 and 10 to remain visible.

However this code from above,
Code:
Private Sub Worksheet_Change(ByVal Target As Range)


Dim rng As Range, sh As Worksheet
Dim shFirst As Long, shLast As Long


Set rng = Range("Z3:Z39") 'range to check
shFirst = 4 'first sheet codename
shLast = 39 'last sheet codename


If Not Intersect(Target, rng) Is Nothing Then
    For Each sh In ThisWorkbook.Worksheets
        If Replace(sh.CodeName, "Sheet", "") >= shFirst Then
            If Replace(sh.CodeName, "Sheet", "") <= shLast Then
                If IsError(Application.Match(sh.Name, rng, 0)) Then
                    sh.Visible = False
                Else
                    sh.Visible = True
                End If
            End If
        End If
    Next
End If

Works as required IF the sheet is already the same name as the one you are entering or deleting.
So as an example
if I start in Z3 and name the sheets A,B,C and the worksheets are renamed on the tabs as A,B,C then deleting B hides sheet B but if I then type in Paul the script fails as there is no sheet named PAUL but if I type B back in the same cell I removed it from then Worksheet B is revealed as expected.

If you have got through all this and are still with me a massive thank you. If you can also help resolve this last problem then that would be great,
Thank you all once again for the great Forum and support.
 
Upvote 0
How about
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim Ws As Worksheet
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Target, Range("Z3:Z39")) Is Nothing Then Exit Sub
   
      For Each Ws In Worksheets
         If Ws.CodeName = "Sheet" & Target.Row + 1 Then
            If Target.Value = "" Then
               Ws.Visible = False
            Else
               Ws.Name = Target.Value
               Ws.Visible = True
            End If
            Exit For
         End If
      Next Ws

End Sub
 
Upvote 0
Thank you so much all.
Fluff,
That has cracked it.
Testing did throw up one thing though, my fault no one else's, I had copied the sheets after a certain point and added them to the end of the list so when I first started it worked up till about sheet 15 then went all over the place.
Once I got the code sheet name order to match the tab sheet name order everything fell into place.
Thank you all once again,
Mick.
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0
How about
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim Ws As Worksheet
   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Target, Range("Z3:Z39")) Is Nothing Then Exit Sub
   
      For Each Ws In Worksheets
         If Ws.CodeName = "Sheet" & Target.Row + 1 Then
[B][COLOR="#FF0000"]            If Target.Value = "" Then
               Ws.Visible = False
            Else
               Ws.Name = Target.Value
               Ws.Visible = True
            End If[/COLOR][/B]
            Exit For
         End If
      Next Ws

End Sub
I believe the red highlighted code lines can be replaced with these two code lines...
Code:
If Len(Target.Value) Then Ws.Name = Target.Value
Ws.Visible = Len(Target.Value)
 
Upvote 0
I believe the red highlighted code lines can be replaced with these two code lines...
Code:
If Len(Target.Value) Then Ws.Name = Target.Value
Ws.Visible = Len(Target.Value)

Thank you Rick that also work a treat. I have another question, Please let me know if you need another thread starting and I will if need be, but could a piece of code be added that says if I add a name into one of the cells in the range where there is not a matching sheet that it would create a new one or copy the last one and place it at the end of the current sheets?

This is more an academic question as for the current project I have created a sheet to match every cell where a name can be entered but there are 30 plus hidden sheets and it has occurred to me that if they were created and deleted from the code then the workbook would possibly be smaller in size and quicker.
Many thanks once again,
Mick.
 
Upvote 0

Forum statistics

Threads
1,223,237
Messages
6,170,928
Members
452,366
Latest member
TePunaBloke

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