Auto Hide Columns based on date

[ExcelRoy]

Hi all,

Would it be possible to automatically hide columns based on todays date

I have a GANTT chart with dates in column (FM1:APX1) and would like to auto hide based on todays date

The week commencing todays date and 4 full weeks after tiodays date

Many thabnsk for any help

 

[vladimiratanasiu]

Hi all,

Would it be possible to automatically hide columns based on todays date

I have a GANTT chart with dates in column (FM1:APX1) and would like to auto hide based on todays date

The week commencing todays date and 4 full weeks after tiodays date

Many thabnsk for any help

Did you try this? How to automatically hide columns based on date in Excel?

 

[ExcelRoy]

Hi vladimiratanasiu,

Many thanks for this
Can the contents of K4 be static and set as today and how do we change the range to suit this working week and the next 4 full weeks?

Thanks for the help

 

[vladimiratanasiu]

Try this, adjusting in the macro your proper references.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dt As Range
  If Intersect(Target, Range("K4")) Is Nothing Then Exit Sub
  Columns("M:W").Hidden = False
   For Each dt In Range("M4:W4")
    If dt.Value < [K4] Or dt.Value > [K4+28] Then Columns(dt.Column).Hidden = True
   Next dt
End Sub

Hide columns.xlsm
	K	L	M	N	O	P	Q	R	S	T	U	V	W
4	7-Jun-23		9-May-23	16-May-23	23-May-23	30-May-23	6-Jun-23	13-Jun-23	20-Jun-23	27-Jun-23	4-Jul-23	11-Jul-23	18-Jul-23
5			-35	-26	-17	-8	1	10	19	28	37	46	55
6			-34	-25	-16	-7	2	11	20	29	38	47	56
7			-33	-24	-15	-6	3	12	21	30	39	48	57
8			-32	-23	-14	-5	4	13	22	31	40	49	58
9			-31	-22	-13	-4	5	14	23	32	41	50	59
10			-30	-21	-12	-3	6	15	24	33	42	51	60
11			-29	-20	-11	-2	7	16	25	34	43	52	61
12			-28	-19	-10	-1	8	17	26	35	44	53	62
13			-27	-18	-9	0	9	18	27	36	45	54	63
Sheet2

 

[vladimiratanasiu]

Hi vladimiratanasiu,

Many thanks for this
Can the contents of K4 be static and set as today and how do we change the range to suit this working week and the next 4 full weeks?

Thanks for the help

If you want to be considered the present week too, change in the macro the value 28 with 35 and insert in K4 its first working day (e.g. 05.06.2023). This weekly table is just a sample, but you can use one as detailed as you need for.

Hide columns.xlsm
	K	L	M	N	O	P	Q	R	S	T
4	5-Jun-23		26-May-23	27-May-23	28-May-23	29-May-23	5-Jun-23	12-Jun-23	19-Jun-23	26-Jun-23
5			-35	-26	-17	-8	1	10	19	28
6			-34	-25	-16	-7	2	11	20	29
7			-33	-24	-15	-6	3	12	21	30
8			-32	-23	-14	-5	4	13	22	31
9			-31	-22	-13	-4	5	14	23	32
10			-30	-21	-12	-3	6	15	24	33
11			-29	-20	-11	-2	7	16	25	34
12			-28	-19	-10	-1	8	17	26	35
13			-27	-18	-9	0	9	18	27	36
Sheet2

 

[ExcelRoy]

Hi vladimiratanasiu,

Many thanks, almost there, K4 is set as =now() and the desired result would show week beginning from a monday and the following 4 full weeks

Thanks

 

[ExcelRoy]

Hi vladimiratanasiu,

Thought it important to add that U1:APX1 is single dates and not weeks

Thanks

 

[vladimiratanasiu]

Try the below macro. My original table was larger (26.05-21.07.2023 - columns M-BQ). This one includes the period collapsed automatically, between the most recent Monday date (05.06) and 5 weeks after it (10.07). You need to adjust the references from the macro to your proper requirements.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dt As Range
  If Intersect(Target, Range("K4")) Is Nothing Then Exit Sub
  Columns("M:BQ").Hidden = False
   For Each dt In Range("M4:BQ4")
    If dt.Value < (Date - Weekday(Date, vbMonday) + 1) Or dt.Value > DateAdd("d", 35, (Date - Weekday(Date, vbMonday) + 1)) Then Columns(dt.Column).Hidden = True
   Next dt
End Sub

Hide columns.xlsm
	K	L											W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ	BA	BB	BC	BD	BE	BF												BR
1
2
3													1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32	33	34	35	36
4	6/8/2023												6/5/2023	6/6/2023	6/7/2023	6/8/2023	6/9/2023	6/10/2023	6/11/2023	6/12/2023	6/13/2023	6/14/2023	6/15/2023	6/16/2023	6/17/2023	6/18/2023	6/19/2023	6/20/2023	6/21/2023	6/22/2023	6/23/2023	6/24/2023	6/25/2023	6/26/2023	6/27/2023	6/28/2023	6/29/2023	6/30/2023	7/1/2023	7/2/2023	7/3/2023	7/4/2023	7/5/2023	7/6/2023	7/7/2023	7/8/2023	7/9/2023	7/10/2023
5													55	64	73	82	91	100	109	118	127	136	145	154	163	172	181	190	199	208	217	226	235	244	253	262	271	280	289	298	307	316	325	334	343	352	361	370
6													56	65	74	83	92	101	110	119	128	137	146	155	164	173	182	191	200	209	218	227	236	245	254	263	272	281	290	299	308	317	326	335	344	353	362	371
7													57	66	75	84	93	102	111	120	129	138	147	156	165	174	183	192	201	210	219	228	237	246	255	264	273	282	291	300	309	318	327	336	345	354	363	372
Sheet2

Cell Formulas
Range	Formula
K4	K4	=NOW()

 

[vladimiratanasiu]

I made a small adjustment to the code, considering that 35 days include the first Monday, too.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dt As Range
  If Intersect(Target, Range("K4")) Is Nothing Then Exit Sub
  Columns("M:BQ").Hidden = False
   For Each dt In Range("M4:BQ4")
    If dt.Value < (Date - Weekday(Date, vbMonday) + 1) Or dt.Value > DateAdd("d", 34, (Date - Weekday(Date, vbMonday) + 1)) Then Columns(dt.Column).Hidden = True
   Next dt
End Sub

 

[ExcelRoy]

Perfect many thanks for your help vladimiratanasiu