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

enter image description here

image "collapsed"

enter image description here

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

Popular posts from this blog

android - MPAndroidChart - How to add Annotations or images to the chart -

javascript - Add class to another page attribute using URL id - Jquery -

firefox - Where is 'webgl.osmesalib' parameter? -