Hide columns by date criteria
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
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
End Sub
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
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
End Sub
"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
- 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
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
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