excel - Delete lines VBA macro takes a significant amount of time -
i have macro deletes lines based on value in column , sorts them. works fine. however, worksheet starts 4000 rows , macro ends deleting 2000 of them , takes 1 minute 25 seconds it. i'm wondering if there's can make take lot less time. here's code:
'remove numbers not allowed based on values in "limitedelements" worksheet = imax 1 step -1 = sheets("fatigueresults").cells(i, 1).value set b = sheets("limitedelements").range("a:a") set c = b.find(what:=a, lookin:=xlvalues) if not c nothing sheets("fatigueresults").rows(i).entirerow.delete end if next 'delete unecessary or redundant rows , columns rows(3).entirerow.delete rows(1).entirerow.delete columns(23).entirecolumn.delete columns(22).entirecolumn.delete columns(21).entirecolumn.delete columns(20).entirecolumn.delete columns(14).entirecolumn.delete columns(13).entirecolumn.delete columns(12).entirecolumn.delete columns(11).entirecolumn.delete columns(4).entirecolumn.delete columns(3).entirecolumn.delete columns(2).entirecolumn.delete 'sort data dim strdatarange range dim keyrange range set strdatarange = range("a:q") set keyrange1 = range("b1") set keyrange2 = range("g1") strdatarange.sort key1:=keyrange1, order1:=xldescending, key2:=keyrange2, order2:=xldescending, header:=xlyes 'delete rows not in included values = imax 2 step -1 if (cells(i, 2).value <> 0.04 , cells(i, 2).value <> 0.045 , cells(i, 2).value <> 0.05 , cells(i, 2).value <> 0.056 , cells(i, 2).value <> 0.063 , cells(i, 2).value <> 0.071 , cells(i, 2).value <> 0.08 , cells(i, 2).value <> 0.09 or cells(i, 3).value <= 0) activesheet.rows(i).entirerow.delete end if next
add @ beginning:
application.screenupdating = false application.enableevents = false application.calculation = xlcalculationmanual add @ end:
application.screenupdating = true application.enableevents = true application.calculation = xlcalculationautomatic also, instead of
if (cells(i, 2).value <> 0.04 , cells(i, 2).value <> 0.045 , cells(i, 2).value <> 0.05 , cells(i, 2).value <> 0.056 , cells(i, 2).value <> 0.063 , cells(i, 2).value <> 0.071 , cells(i, 2).value <> 0.08 , cells(i, 2).value <> 0.09 or cells(i, 3).value <= 0) activesheet.rows(i).entirerow.delete end if use
select case cells(i, 2) case 0.4, 0.045, 0.05, 0.056, 0.063, 0.071, 0.08, 0.09, < 0 'do nothing case else activesheet.rows(i).entirerow.delete end select
Comments
Post a Comment