excel - How to filter on one column, then filter on the next, then another and copy the total of all three filters? -


i have been struggling filtering 3 columns , taking whatever comes each of 3 columns (combined) , copying all. so, if column 1 returns 1 row , column 2 return 2 rows , column 3 returns 1 row. want see 5 rows @ 1 time , copy them. code doesn't seem work when there no data comes in filter. so, i'm thinking need if statement, reason gives me error "run-time error'1004': application-defined or object-defined error" @ .autofilter field:=11, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor

thanks in advance have! i've been working day trying out code fix error.here's code.

sub filterdifferences()   'filtering differences dim ws worksheet dim rng range dim rngk range dim rngl range dim rngm range dim lrow long  set ws = sheets("sheet1")  ws     '~~> last row of col m     lrow = .range("m" & .rows.count).end(xlup).row      '~~> identify range     set rng = .range("a1:m" & lrow)      .autofiltermode = false      '~~> identify range in col k has red font      rng     .autofilter field:=11, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor     set rngk = .offset(1, 0).specialcells(xlcelltypevisible)     end      .autofiltermode = false      '~~> identify range in col l has red font     rng         .autofilter field:=12, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor     set rngl = .offset(1, 0).specialcells(xlcelltypevisible)     end    .autofiltermode = false              '~~> identify range in col m has red font     rng         .autofilter field:=13, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor     set rngm = .offset(1, 0).specialcells(xlcelltypevisible)     end      activesheet.autofiltermode = false      '~~> hide except header row     rng.offset(1, 0).entirerow.hidden = true     '~~> unhide rows have red font     union(rngk, rngl, rngm).entirerow.hidden = false   end  'copying differences , putting them file activesheet.usedrange.specialcells(xlcelltypevisible).select selection.copy  end sub 

not sure why you're getting error, code works on excel 2007 here, even if entire table contains no red font cells. time error if there no data in table @ all.

that said, following how trap , ignore errors:

with rng   .autofilter field:=11, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor   on error resume next     set rngk = .offset(1, 0).specialcells(xlcelltypevisible)   on error goto 0   if rngk nothing     msgbox "error filtering col k"   end if end 

you can check error occurred checking if range nothing.


edit:

the reason can think of getting errors, have corrupted workbook or corrupted excel.

you try creating new workbook , copy/pasting vba code , table data , see if fixes issue.

for problems excel try following:

  1. start excel in safe mode eliminate addin issues.
  2. try repairing excel.
  3. try reinstalling office.

note each of above steps may not fix faulty workbook, newly create workbook might work.

with respect new working code (excluding use of with ws , with rng) if correctly wrapping all three of .specialcells... lines error trapping technique, there no way of ranges nothing when union.


i have included 3 code examples try. 3 work correctly in version of excel, even no data @ in table.

the first 1 original code better "last row" algorithm, 3 column checks rolled loop, , elimination of unnecessary variables:

sub filterdifferences1()     'filtering differences   dim rng range   dim rngunion range   dim varcolnum variant   dim lrow long    sheets("sheet1")     '~~> last row of col m (need use match() .end(xlup).row finds last visible row     set rng = .range("m:m")     worksheetfunction       on error resume next         lrow = 1         lrow = .max(lrow, .match(1e+306, rng, 1))         lrow = .max(lrow, .match("*", rng, -1))       on error goto 0     end      '~~> identify range , use     .range("a1:m" & lrow)       .entirerow.hidden = false        '~~> build range of every col has red font       set rngunion = .rows(1)       each varcolnum in array(11, 12, 13)         '~~> identify range in current col has red font         .autofilter field:=varcolnum, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor         set rngunion = union(rngunion, .offset(1, 0).specialcells(xlcelltypevisible))         .autofilter ' turns autofilter off , shows rows       next varcolnum        '~~> hide except header row       .offset(1, 0).entirerow.hidden = true        '~~> unhide rows have red font       rngunion.entirerow.hidden = false     end      'copying differences , putting them file     .usedrange.specialcells(xlcelltypevisible).select     selection.copy   end  end sub 

the second 1 new working code (as understand) better "last row" algorithm added:

sub filterdifferences2()     'filtering differences   dim ws worksheet   dim rng range   dim rngk range   dim rngl range   dim rngm range   dim lrow long    set ws = sheets("sheet1")    '~~> last row of col m (need use match() .end(xlup).row finds last visible row   set rng = range("m:m")   worksheetfunction     on error resume next       lrow = 1       lrow = .max(lrow, .match(1e+306, rng, 1))       lrow = .max(lrow, .match("*", rng, -1))     on error goto 0   end    '~~> identify range , use   range("a1:m" & lrow).entirerow.hidden = false    '~~> identify range in col k has red font   range("a1:m" & lrow).autofilter field:=11, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor '  on error resume next     set rngk = activesheet.autofilter.range.offset(1, 0).specialcells(xlcelltypevisible) '  on error goto 0   if rngk nothing     set rngk = range("a1:m1")   end if   range("a1:m" & lrow).autofilter ' turns autofilter off , shows rows    '~~> identify range in col l has red font   range("a1:m" & lrow).autofilter field:=12, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor   on error resume next     set rngl = activesheet.autofilter.range.offset(1, 0).specialcells(xlcelltypevisible)   on error goto 0   if rngl nothing     set rngl = range("a1:m1")   end if   range("a1:m" & lrow).autofilter ' turns autofilter off , shows rows    '~~> identify range in col m has red font   range("a1:m" & lrow).autofilter field:=13, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor   on error resume next     set rngm = activesheet.autofilter.range.offset(1, 0).specialcells(xlcelltypevisible)   on error goto 0   if rngm nothing     set rngm = range("a1:m1")   end if   range("a1:m" & lrow).autofilter ' turns autofilter off , shows rows    '~~> hide except header row   range("a1:m" & lrow).offset(1, 0).entirerow.hidden = true    '~~> unhide rows have red font   on error resume next     union(rngk, rngl, rngm).entirerow.hidden = false   on error goto 0    'copying differences , putting them file   ws.usedrange.specialcells(xlcelltypevisible).select   selection.copy  end sub 

the last 1 new working code better "last row" algorithm, 3 column checks rolled loop, , elimination of unnecessary variables:

sub filterdifferences3()     'filtering differences   dim rng range   dim rngunion range   dim varcolnum variant   dim lrow long    sheets("sheet1")     '~~> last row of col m (need use match() .end(xlup).row finds last visible row     set rng = .range("m:m")     worksheetfunction       on error resume next         lrow = 1         lrow = .max(lrow, .match(1e+306, rng, 1))         lrow = .max(lrow, .match("*", rng, -1))       on error goto 0     end      '~~> identify range , use     range("a1:m" & lrow)       .entirerow.hidden = false        '~~> build range of every col has red font       set rngunion = range("a1:m1")       each varcolnum in array(11, 12, 13)         '~~> identify range in current col has red font         .autofilter field:=varcolnum, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor         on error resume next           set rngunion = union(rngunion, activesheet.autofilter.range.offset(1, 0).specialcells(xlcelltypevisible))         on error goto 0         .autofilter ' turns autofilter off , shows rows       next varcolnum        '~~> hide except header row       .offset(1, 0).entirerow.hidden = true        '~~> unhide rows have red font       rngunion.entirerow.hidden = false     end      'copying differences , putting them file     .usedrange.specialcells(xlcelltypevisible).select     selection.copy   end  end sub  sub filterdifferences3a()     'filtering differences   dim ws worksheet   dim aarng range   dim rng range   dim rngk range   dim rngl range   dim rngm range   dim lrow long    set ws = sheets("sheet1")    ws     '~~> last row of col m (need use match() .end(xlup).row finds last visible row     set rng = .range("m:m")     worksheetfunction       on error resume next         lrow = 1         lrow = .max(lrow, .match(1e+306, rng, 1))         lrow = .max(lrow, .match("*", rng, -1))       on error goto 0     end      '~~> identify range , use     range("a1:m" & lrow)       .entirerow.hidden = false        '~~> identify range in col k has red font       .autofilter field:=11, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor       on error resume next         set rngk = activesheet.autofilter.range.offset(1, 0).specialcells(xlcelltypevisible)       on error goto 0       if rngk nothing set rngk = range("a1:m1")       .autofilter ' turns autofilter off , shows rows        '~~> identify range in col l has red font       .autofilter field:=12, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor       on error resume next         set rngl = activesheet.autofilter.range.offset(1, 0).specialcells(xlcelltypevisible)       on error goto 0       if rngl nothing set rngl = range("a1:m1")       .autofilter ' turns autofilter off , shows rows        '~~> identify range in col m has red font       .autofilter field:=13, criteria1:=rgb(192, 0, 0), operator:=xlfilterfontcolor       on error resume next         set rngm = activesheet.autofilter.range.offset(1, 0).specialcells(xlcelltypevisible)       on error goto 0       if rngm nothing set rngm = range("a1:m1")       .autofilter ' turns autofilter off , shows rows        '~~> hide except header row       .offset(1, 0).entirerow.hidden = true        '~~> unhide rows have red font       union(rngk, rngl, rngm).entirerow.hidden = false     end      'copying differences , putting them file     .usedrange.specialcells(xlcelltypevisible).select     selection.copy   end  end sub 

Comments

Popular posts from this blog

angular - Ionic slides - dynamically add slides before and after -

minify - Minimizing css files -

Add a dynamic header in angular 2 http provider -