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:
- start excel in safe mode eliminate addin issues.
- try repairing excel.
- 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
Post a Comment