We help IT Professionals succeed at work.

Hide columns by date criteria

Charlie9200
Charlie9200 asked
on
Medium Priority
204 Views
Last Modified: 2012-05-12
Hi - I am using excel 2003 and need to modify the VBA for ThisWorkbook (see below) to automatically reduce row height of rows to .4 with dates in Worksheet Labelled "Health Check Scorecard" that are prior to today's date and any dates that are today+365X2 (2 years).  the VBAProject list indicates in Sheet2.

Is it possible to do something similar to Sheet1(XYZ) and Sheet8(ABC):  however in these 2 sheets, I would like to just automatically hide all rows with dates that are less than today - 6months.    

Is it possible to adjust the macro below to reflect above?  

thanks in advance for your help.
ub Workbook_Open()

  Application.ScreenUpdating = False
    Dim wkSht As Worksheet


    For Each wkSht In ActiveWorkbook.Worksheets
        With wkSht
            If .ProtectContents = True Then .Protect UserInterfaceOnly:=True, AllowFiltering:=True, Password:="awake"
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            Else
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
          If .Visible = xlSheetVisible Then
            .Select
            .[a1].Select
 
            With ActiveWindow
              .Zoom = 75
              .ScrollRow = 1
              .ScrollColumn = 1
            End With
          End If
        End With
    Next wkSht
     
    Worksheets(1).Select
  Application.ScreenUpdating = True
End Sub
Comment
Watch Question

Could these dates be anywhere? Perhaps you could post a small sample workbook?

Author

Commented:
"Health Check Scorecard" that are prior to today's date and any dates that are today+365X2 (2 years).  the VBAProject list indicates in Sheet2.

- date is alway in Column B - starting from B61 to B600. The date is a link to another worksheet (XYZ). (see attached)

Is it possible to do something similar to Sheet1(XYZ) and Sheet8(ABC):  however in these 2 sheets, I would like to just automatically hide all rows with dates that are less than today - 6months.  

yes - date is always in Column F for both (again these are links from other sheets in the workbook that I are not attached since file is too big.


Hide-Columns-based-on-Dates.xls
So where does the hiding columns come into it?

Author

Commented:
okay not hidding but reducing the row height to .4 so it's not visible.  Originally I wanted to hide but I have a VBA in the worksheet that unfilters all so any rows where there are filters will always come open again.   If you can figure out a way using that's great - then hide vs. reducing row height to .4
Just to clear though, you are talking about hiding/reducing height of rows, not width of columns?

Author

Commented:
yes -rows and not width of columns
See if this works:
Sub Workbook_Open()

  Application.ScreenUpdating = False
    Dim wksht As Worksheet
    Dim r As Range

    For Each wksht In ActiveWorkbook.Worksheets
        With wksht
            If .ProtectContents = True Then .Protect UserInterfaceOnly:=True, AllowFiltering:=True, Password:="awake"
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            Else
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
          If wksht.Name = "Health Check Scorecard" Then
            For Each r In wksht.Range("B61:B600")
                If IsDate(r) Then
                    If r.Value < Date Or r.Value >= Date + 730 Then
                        r.EntireRow.RowHeight = 0.4
                    End If
                End If
            Next r
          ElseIf wksht.Name = "XYZ" Or wksht.Name = "ABC" Then
            For Each r In wksht.Range("F6", wksht.Range("F" & Rows.Count).End(xlUp))
                If IsDate(r) Then
                    If r.Value < Date - 182 Then
                        r.EntireRow.RowHeight = 0.4
                    End If
                End If
            Next r
          End If
          If .Visible = xlSheetVisible Then
            .Select
            .[a1].Select
 
            With ActiveWindow
              .Zoom = 75
              .ScrollRow = 1
              .ScrollColumn = 1
            End With
          End If
        End With
    Next wksht
      
    Worksheets(1).Select
  Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
Yes works - thank you so much.  Only issue is it takes 3-4 minutes to open file.   Is there any way to speed opening time?
Does your actual file have lots of sheets or other code? I didn't experience any problems.

Author

Commented:
Yes - 10 sheets

Explore More ContentExplore courses, solutions, and other research materials related to this topic.