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.

 

[ClwnMan76]

Unfortunately I"ve ran in to a bit of a problem once the sheet is protected. Your thoughts?

https://1drv.ms/f/s!Aha8qpnTJbXYg-c3p3fd6ISpniWFZg

It may just be me. Going to sleep and come back to this.

 

[DanteAmor]

Try this.
Change "abc" for the password of your sheets.

Note: All sheets should have the same password, that way we could have a single line for all sheets.

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))
[COLOR=#0000ff]    sh.unprotect "[/COLOR][B][COLOR=#ff0000]abc[/COLOR][/B][COLOR=#0000ff]"[/COLOR]
    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
[COLOR=#0000ff]    sh.protect "[/COLOR][B][COLOR=#ff0000]abc[/COLOR][/B][COLOR=#0000ff]"  [/COLOR]
  Next
  Application.ScreenUpdating = True
End Sub

 

[ClwnMan76]

Apologies for not including that to begin with!

~Todd~

 

[DanteAmor]

It already works for you?

 

[ClwnMan76]

It already works for you?

It does work. Thanks again!

 

[ClwnMan76]

It already works for you?

It seems to lock those sheets it runs on if they are unlocked. Is there a way to put some kind of "if" statement in there in case they aren't locked? If not, it's a big deal I can work around it.

 

[DanteAmor]

It seems to lock those sheets it runs on if they are unlocked. Is there a way to put some kind of "if" statement in there in case they aren't locked? If not, it's a big deal I can work around it.

Try this

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, wFlag As Boolean
  Application.ScreenUpdating = False
  BeginRow = 3
  EndRow = 150
  ChkCol = 35
  For i = 1 To 12
    Set sh = Sheets(MonthName(i, True))
    wFlag = False
    If sh.ProtectContents Then
      wFlag = True
      sh.Unprotect "[COLOR=#ff0000]abc[/COLOR]"
    End If
    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
    If wFlag Then sh.Protect "[COLOR=#ff0000]abc[/COLOR]"
  Next
  Application.ScreenUpdating = True
End Sub

 

[ClwnMan76]

WOW! You're truly a rockstar.

Is there anything you CAN'T do?

Soooo thankful for your help!

 

[DanteAmor]

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

 

[ClwnMan76]

So I've run in to a problem when copying data from another workbook to the one we've been working on. sheets aren't updating. So i thought I'd just select a cell on that sheet thinking it would update, but I think it's selecting the cell in the sourceWorkbook and not the current one. Does that make sense?

The first part of code is below. The part I THOUGHT I had right is in red below.

Sub Copyaug()    Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   
   Set DestWbk = ThisWorkbook
     
   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)
   
  Dim answer As Integer
  answer = MsgBox("Did You Pick The Correct File?", vbQuestion + vbYesNo)
 
  If answer = vbNo Then Exit Sub  


   MsgBox "Your Screen May Look Frozen While Importing." & vbNewLine & vbNewLine & "Just Be Patient!", vbOKCancel + vbQuestion
   Application.ScreenUpdating = False
   
'MISC Assignments
SrcWbk.Sheets("MAIN").Range("i3:i22").Copy: DestWbk.Sheets("MAIN").Range("i3").PasteSpecial xlPasteValuesAndNumberFormats
SrcWbk.Sheets("MAIN").Range("k3:K22").Copy: DestWbk.Sheets("MAIN").Range("k3").PasteSpecial xlPasteValuesAndNumberFormats
[COLOR=#ff0000]DestWbk.Sheets("MAIN").Select
    Range("K4").Select[/COLOR]
Application.CutCopyMode = False