excel - Hide columns based on dates in rows (Gantt table header) VBA -
i've created gantt table in excel , i'm using macros expand or collapse dates weeks, workweeks, calender weeks , months. trick is: saturdays , sundays hashed conditional formatting , therefore shouldn't appear when collapsed. far i've managed make months option work correctly. here code collapse month have far:
sub month_collapse() dim lastcol long, x long columns("h:sss").columnwidth = 3.45 'hide columns lastcol = activesheet.cells(4, columns.count).end(xltoleft).column x = 8 lastcol if (cells(4, x).text) = 28 , (cells(5, x).text) <> "sat" , (cells(5, x).text) <> "sun" columns(x).hidden = false 'columnwidth = 10 else columns(x).hidden = true end if next end sub
row 2 populated months. row 4 populated days in number. "14". row 5 populated weekdays text. "mon" or "sat". i've tried include following, many columns displayed.
if (cells(4, x).text) = 28 , (cells(5, x).text) <> "sat" , (cells(5, x).text) <> "sun" columns(x).hidden = false elseif (cells(4, x).text) = 29 , (cells(5, x).text) <> "sat" , (cells(5, x).text) <> "sun" columns(x).hidden = false elseif (cells(4, x).text) = 30 , (cells(5, x).text) <> "sat" , (cells(5, x).text) <> "sun" columns(x).hidden = false
i possible post code generates header dates , code collapses weeks. not sure if long post here already...
image header row visible
image "collapsed"
edit: next macro creates header. after created i´d macro hide columns except column last day of each month. if such day weekend day, macro should take previous friday.
sub create_date_header_macro() dim initialcell range dim initialdate date '==================================================================================== 'project starting date '''initialdate = "01.05.2015" ' example initialdate = application.inputbox(prompt:="enter initial date: (dd.mm.yyyy)") if initialdate = false exit sub '==================================================================================== application.screenupdating = false application.displayalerts = false activesheet.unprotect cells.select selection.locked = false range("h1:zz5").clearcontents range("h1:zz5").unmerge set initialcell = range("g1") initialcell.activate activecell.offset(3, 1) = initialdate ' activecell.offset(3, 1).numberformat = "d-mmm" 'change date display mode here activecell.offset(3, 1).numberformat = "dd" 'add week number activecell.offset(2, 1).formular1c1 = "=weeknum(r[1]c,2)" activecell.offset(2, 1).numberformat = "general" 'add month activecell.offset(1, 1).formular1c1 = _ "=if(month(r[2]c)=1,""january"",if(month(r[2]c)=2,""february"",if(month(r[2]c)=3,""march"",if(month(r[2]c)=4,""april"",if(month(r[2]c)=5,""may"",if(month(r[2]c)=6,""june"",if(month(r[2]c)=7,""july"",if(month(r[2]c)=8,""august"",if(month(r[2]c)=9,""september"",if(month(r[2]c)=10,""october"",if(month(r[2]c)=11,""november"",if(month(r[2]c)=12,""december""))))))))))))" 'add weekday activecell.offset(4, 1).formular1c1 = "=r[-1]c" activecell.offset(4, 1).numberformat = "[$-2c09]ddd;@" 'add year activecell.offset(0, 1).formular1c1 = "=year(r[3]c)" activecell.offset(0, 1).numberformat = "general" 'copy formats next column activecell.offset(0, 1).range("a1:a5").select activecell.activate selection.copy activecell.offset(0, 1).range("a1").select activesheet.paste application.cutcopymode = false ' date equal starting date + 1 activecell.offset(3, 0).formular1c1 = "=rc[-1]+1" 'fill header selection.autofill destination:=activecell.range("a1:ae5"), type:= _ xlfilldefault 'streatch table conditional formats columns columns("aa:aa").select selection.autofill destination:=columns("aa:tt"), type:=xlfilldefault 'select dates range("h1:h5").select range(selection, selection.end(xltoright)).select 'copy + paste especial: values selection .copy .pastespecial paste:=xlpastevalues, operation:=xlnone, skipblanks _ :=false, transpose:=false .columns.autofit .horizontalalignment = xlcenter .verticalalignment = xlcenter end call mergecells ' call organize range("h8").select application.displayalerts = true application.screenupdating = true end sub private sub mergecells() dim rngmerge range, cell range set rngmerge = range("h2:sss3") 'set ranges merged here mergeagain: each cell in rngmerge if cell.value = cell.offset(0, 1).value , isempty(cell) = false range(cell, cell.offset(0, 1)).merge goto mergeagain end if next 'year cells formated in same size month cells rows(2).select selection.copy rows(1).select selection.pastespecial paste:=xlpasteformats selection.numberformat = "general" application.cutcopymode = false end sub
here's function hides last working day of month. assumes row 4 contains actual date (that happens formatted show day).
sub month_collapse() dim lastcol long, x long dim curmonth integer, priormonth integer dim coldate date, nextmonth date dim lastworkingday integer lastcol = activesheet.cells(4, columns.count).end(xltoleft).column range(columns(8), columns(lastcol)).columnwidth = 3.45 x = 8 lastcol coldate = cells(4, x) curmonth = month(coldate) if curmonth <> priormonth nextmonth = dateserial(year(coldate), month(coldate) + 1, 1) lastworkingday = day(application.workday(nextmonth, -1)) end if if day(coldate) <> lastworkingday columns(x).hidden = true end if next x end sub
Comments
Post a Comment