Hide Columns outside of date range

[JonReyno]

Hi all,

I'm after some help if you will.

I have a single worksheet that has every day of the financial year (as from 17th June) on it starting in cell C5 through to Cell KD5 (being 31st March 2014).

I am looking to only show data from today back 2 weeks so it will be a rolling 2 week period. Within the data I have columns A and B which need to be visable at all times.

Does anyone have any ideas either with VBA/Macros or another solution how I would be able to do this. I had it in my mind that when you open the workbook the code automatically runs to show the day you open the file back 2 weeks.

I'm really hoping someone can help as I have been racking my brain trying to work out how I can do it.

I am using Excel 2010.

Many Thanks
Jon

 

[MirakelMan]

Hi Jon,
This bit of code should do exactly what you want.
To Enter the VBA Editor press Alt+F11.
Put the following in the ThisWorkbook mS Excel Objects of the workbook you have the report in.

Private Sub Workbook_Open()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Sheet1") 'change this to the sheetname of your report
ws.Activate
Call HideColumns
End Sub

After adjusting the Sheetname you can Insert a new module to the Project (Insert à module) and enter the following code in there:

Public Sub HideColumns()
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("C5:KD5") '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

Hope it works.

 

[JonReyno]

That has worked prefectly, well, so far, the test will be tomorrow to see if it calulates correctly, but I have every faith it will do. I removed the message box as it was just coming up wiht a '0' for some reason, but thats not an issue as I have set the format as a button.

Thank you for your help, you have saved me a lot of time!!

Jon

 

[JonReyno]

Hi Jon,
This bit of code should do exactly what you want.
To Enter the VBA Editor press Alt+F11.
Put the following in the ThisWorkbook mS Excel Objects of the workbook you have the report in.

Private Sub Workbook_Open()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Sheet1") 'change this to the sheetname of your report
ws.Activate
Call HideColumns
End Sub

After adjusting the Sheetname you can Insert a new module to the Project (Insert à module) and enter the following code in there:

Public Sub HideColumns()
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("C5:KD5") '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

Hope it works.

I knew it would be too good to be true!!

When my colleagues open this file it comes up with a Run Time error which is 'Run-time error '91': Object variable or With block variable not set'.

Prior to the error appearing you have to enable the document for editing, not sure if this has an impact on why the error is appearing.

Is there any way around it? The macro that is trying to run is:


Private Sub Workbook_Open()Dim wb As WorkbookDim ws As WorksheetSet wb = ActiveWorkbookSet ws = wb.Worksheets("Sheet1") 'change this to the sheetname of your reportws.ActivateCall HideColumnsEnd SubI hope you can help me resolve this issue.ThanksJon</PRE>