VBA - Maybe Looping - Activate Multiple Sheets?

[ClwnMan76]

First of all, good morning and thanks to all of you who come on here and help us out and never asking much in return. You've inspired me to go to other forums where I actually do something about the subject and help out.

I seem to have a sick dog now that is wanting attention so I've broken down to ask for assistance on a couple things.

As you can see by what I have so far it works, but I know there's gotta be a more efficient way to write and execute this. I have a sheet, 3 letters, for each day of the month. There are 16 sheets in all. I was reading up on cycling through the whole spreadsheet and that's perfectly fine as the sheets that aren't a month won't mess anything up.

Oh, and feel free to correct anything else i have. I'd really like to learn where I can improve!!

I don't know if I can post a second problem, but I was trying to create some code that monitored k2:k22 on the "MAIN" sheet for changes and then would run the code below, but after a few hours I gave up and added a button. LOL See below.

Sub HideUnhide()    
    Application.ScreenUpdating = False
    
    Worksheets("JAN").Activate
    BeginRow = 3
    EndRow = 150
    ChkCol = 35


    For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value = "hide" Then
    Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        Else
            Cells(RowCnt, ChkCol).EntireRow.Hidden = False
        End If
    Next RowCnt
    
    Worksheets("FEB").Activate
        BeginRow = 3
    EndRow = 150
    ChkCol = 35


    For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value = "hide" Then
    Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        Else
            Cells(RowCnt, ChkCol).EntireRow.Hidden = False
        End If
    Next RowCnt
    
    Application.ScreenUpdating = True


End Sub

I found this code below that I thought I could edit to fit my needs, but no matter what I did it wouldn't work.

Private SubWorksheet_Change (ByVal Target As Range) 
If Not
Intersect (Target, Range ("A1:B100"))
     Is Nothing Then 
 Call Mymacro 
 End If 
 End Sub

I don't know if this will help or not, but here's the file. If you need the password it's in the MAIN sheet cell d28.

P.S. I apologize if I posted incorrectly. I'm a recent convert from another forum that just became way too negative if you weren't perfect.

 

[DanteAmor]

Try this for the 12 sheets

Sub HideUnhide()
  Dim mon As String, BeginRow As Long, EndRow As Long, ChkCol As Long
  Dim i As Long, RowCnt As Long, sh As Worksheet
  Application.ScreenUpdating = False
  
  BeginRow = 3
  EndRow = 150
  ChkCol = 35
  For i = 1 To 12
    mon = Format(DateSerial(Year(Date), i, 1), "mmm")
    Set sh = Sheets(mon)
    For RowCnt = BeginRow To EndRow
      If LCase(sh.Cells(RowCnt, ChkCol).Value) = LCase("hide") Then
        sh.Cells(RowCnt, ChkCol).EntireRow.Hidden = True
      Else
        sh.Cells(RowCnt, ChkCol).EntireRow.Hidden = False
      End If
    Next RowCnt
  Next i
  Application.ScreenUpdating = True
End Sub

To run the "HideUnhide" macro, put the following in the events of your "main" sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("K2:K22")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    Call HideUnhide
  End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code and paste the code into the window that opens up.

 

[ClwnMan76]

First of all, thank you so much. I feel like I'm making progress!!

It does work for the most part. Just a couple questions if you could tell me if this is normal or not.

1. When highlighting several cells and hitting delete, it doesn't trigger the macro, but if I delete one at a time then it works.

2. It does take quite a while to run. Is this just something I have to deal with for the poor way I designed it?

 

[Rick Rothstein]

Try this for the 12 sheets

Sub HideUnhide()
  Dim mon As String, BeginRow As Long, EndRow As Long, ChkCol As Long
  Dim i As Long, RowCnt As Long, sh As Worksheet
  Application.ScreenUpdating = False
  
  BeginRow = 3
  EndRow = 150
  ChkCol = 35
  For i = 1 To 12
[B][COLOR="#FF0000"]    mon = Format(DateSerial(Year(Date), i, 1), "mmm")
    Set sh = Sheets(mon)
[/COLOR][/B]    For RowCnt = BeginRow To EndRow
      If LCase(sh.Cells(RowCnt, ChkCol).Value) = LCase("hide") Then
        sh.Cells(RowCnt, ChkCol).EntireRow.Hidden = True
      Else
        sh.Cells(RowCnt, ChkCol).EntireRow.Hidden = False
      End If
    Next RowCnt
  Next i
  Application.ScreenUpdating = True
End Sub

You can eliminate the 'mon' variable and set the 'sh' variable directly by replacing the two highlighted lines of code with this single code line...

Set sh = Sheets(MonthName(i, True))

 

[ClwnMan76]

Well unfortunately I don't know as I'm going to be able to do this after all. I timed it, and after entering one name, it took 13.4 seconds. Of course, like most of you, I'm a huge multi-tasker with 10 tabs open. I'm going to restart and see how long it takes, but no matter what I've learned something.

If it ends up working for me I'll update you. Otherwise, I will consider this as solved and save it for future reference.

Thanks again ALL!!

 

[ClwnMan76]

Try this for the 12 sheets

Sub HideUnhide()
  Dim mon As String, BeginRow As Long, EndRow As Long, ChkCol As Long
  Dim i As Long, RowCnt As Long, sh As Worksheet
  Application.ScreenUpdating = False
  
  BeginRow = 3
  EndRow = 150
  ChkCol = 35
  For i = 1 To 12
    mon = Format(DateSerial(Year(Date), i, 1), "mmm")
    Set sh = Sheets(mon)
    For RowCnt = BeginRow To EndRow
      If LCase(sh.Cells(RowCnt, ChkCol).Value) = LCase("hide") Then
        sh.Cells(RowCnt, ChkCol).EntireRow.Hidden = True
      Else
        sh.Cells(RowCnt, ChkCol).EntireRow.Hidden = False
      End If
    Next RowCnt
  Next i
  Application.ScreenUpdating = True
End Sub

This did take care of my problem!! Thank you so much!

 

[DanteAmor]

You can eliminate the 'mon' variable and set the 'sh' variable directly by replacing the two highlighted lines of code with this single code line...

Set sh = Sheets(MonthName(i, True))

Thanks Rick for the good contribution.

 

[DanteAmor]

First of all, thank you so much. I feel like I'm making progress!!

It does work for the most part. Just a couple questions if you could tell me if this is normal or not.

1. When highlighting several cells and hitting delete, it doesn't trigger the macro, but if I delete one at a time then it works.

For security, I always set the counter to 1, if you delete a whole row or a column, the macro can enter a loop.
Change the 1 to say 100 so you can erase about 100 cells.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("K2:K22")) Is Nothing Then
    If Target.Count > [COLOR=#ff0000]100 [/COLOR]Then Exit Sub
    Call HideUnhide
  End If
End Sub

--------------------------

2. It does take[COLOR=#ff0000] quite a while[/COLOR] to run. Is this just something I have to deal with for the poor way I designed it?

Try the following macro, it should be faster.

Sub HideUnhide()
  Dim BeginRow As Long, EndRow As Long, ChkCol As Long, i As Long, j As Long, sh As Worksheet
  Dim a() As Variant, r As Range
  Application.ScreenUpdating = False
  BeginRow = 3
  EndRow = 150
  ChkCol = 35
  For i = 1 To 12
    Set sh = Sheets(MonthName(i, True))
    sh.Rows(BeginRow & ":" & EndRow).EntireRow.Hidden = False
    Set r = sh.Range("A" & EndRow + 1)
    a = sh.Range(sh.Cells(1, ChkCol), sh.Cells(EndRow, ChkCol)).Value
    For j = 1 To UBound(a)
        If LCase(a(j, 1)) = LCase("hide") Then Set r = Union(r, sh.Range("A" & j))
    Next
    r.EntireRow.Hidden = True
    sh.Range("A" & EndRow + 1).EntireRow.Hidden = False
  Next
  Application.ScreenUpdating = True
End Sub

 

[ClwnMan76]

Try the following macro, it should be faster.

HOLY CRAP!!! You're amazing. My friends and family always think I'm the "computer guy". Works pretty well for my ego until I see what you guys can do.

THANK YOU!!!!!!!!!!!

 

[DanteAmor]

HOLY CRAP!!!
THANK YOU!!!!!!!!!!!

I'm glad to help you. I appreciate your kind comments.