Hide Columns Based on Date in Each Column

[Needtoknow]

Hi,
I'm trying to Hide Columns based on the date in each column but only show the past 30 days. Going across the spreadsheet, I have the date in row D (starting at row D16, E16, .........AKY16).
When the user opens the file and selects the macro button, I want it to only show the columns for the past 30 days. I'm stuck.... is there an easier way?

Sub HideColumnsBasedOnDate()
Dim r As Range, c As Range
Application.ScreenUpdating = False

For Each c In r
If Range("D16").Value > Today Then
r.EntireColumn.Hidden = True
Else
r.EntireColumn.Hidden = False
End If
Next c
Application.ScreenUpdating = True

End Sub

 

[JoeMo]

Are the dates sequential? If yes, ascending or descending?

 

[Needtoknow]

Yes, the dates are sequential and ascending

 

[Snakehips]

Needtoknow,

Maybe...

Sub HideColumnsBasedOnDate()
Application.ScreenUpdating = False
Range("D16:AKY16").EntireColumn.Hidden = True
c = Application.WorksheetFunction.Match(CLng(Date), Range("A16:AKY16"), 0)
d = Application.WorksheetFunction.Max(c - 30, 4)
Range(Cells(16, d), Cells(16, c)).EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub

OR MAYBE have it do it automatically as the sheet is activated ????

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Range("D16:AKY16").EntireColumn.Hidden = True
c = Application.WorksheetFunction.Match(CLng(Date), Range("A16:AKY16"), 0)
d = Application.WorksheetFunction.Max(c - 30, 4)
Range(Cells(16, d), Cells(16, c)).EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub

Hope that helps.

 

[JoeMo]

Yes, the dates are sequential and ascending

Ascending means oldest date in D16 and increasing from there?

EDIT: Looks like Snakehips has provided a solution.

 

[Needtoknow]

It doesn't work. I get a run-time 1004 error when I use the following code.

Sub HideColumnsBasedOnDate()
Application.ScreenUpdating = False
Range("D16:AKY16").EntireColumn.Hidden = True
c = Application.WorksheetFunction.Match(CLng(Date), Range("A16:AKY16"), 0)
d = Application.WorksheetFunction.Max(c - 30, 4)
Range(Cells(16, d), Cells(16, c)).EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub

 

[Snakehips]

Is your worksheet protected?

 

[Needtoknow]

No. It's not protected.

 

[Needtoknow]

I figured it out. I used code I found from another similar issue. Thanks for your help

Sub HideColumns2WeekView()
Dim wb As Workbook
Dim ws As Worksheet
Dim rngDates As Range
Dim datToday As Date

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet 'run this macro from the sheet you want the hidden columns
Set rngDates = ws.Range("D16:AJD16") 'this range should match the range of dates

Application.ScreenUpdating = False

'make sure you unhide all columns before hiding them based on dates
rngDates.Select
Selection.EntireColumn.Hidden = False

datToday = Date

For Each cell In rngDates.Cells
If cell.Value <= (datToday - 14) Or cell.Value > datToday Then
cell.Select
Selection.EntireColumn.Hidden = True
End If
Next

ws.Range("A1").Select
Application.ScreenUpdating = True

MsgBox "Done!", vbOKOnly

End Sub

 

[Snakehips]

Ntk,

Glad you are sorted.

Re my code producing an error......

I suspect that your dates are text rather than date serial?
In which case my Match statement will generate the error. This can be overcome but no need given that your code does the job.

It is not really an issue in such a small amount of code but it would be good practice to try and avoid unnecessary selections.
eg....

Sub HideColumns2WeekView()
Dim wb As Workbook
Dim ws As Worksheet
Dim rngDates As Range
Dim datToday As Date


Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet 'run this macro from the sheet you want the hidden columns
Set rngDates = ws.Range("D16:AJD16") 'this range should match the range of dates


Application.ScreenUpdating = False


'make sure you unhide all columns before hiding them based on dates
rngDates.EntireColumn.Hidden = False


datToday = Date


For Each cell In rngDates.Cells
If cell.Value <= (datToday - 14) Or cell.Value > datToday Then
cell.EntireColumn.Hidden = True
End If
Next
ws.Range("A1").Select
Application.ScreenUpdating = True


MsgBox "Done!", vbOKOnly
End Sub