Find change in Col A and insert 4 rows using Excel VBA -
i'm trying code insert 4 rows every time finds difference in cell below. if a5-55 = 1, a56-80 = 2, a81 - 100 = 3 want code see 56 isn't equal 55 , insert 4 rows, continue down column until there no more values.
i keep getting error excel,
can not complete task. resources error
and runtime 1004 insert method of range class failed, , debugger highlights code inserting rows
this data looks like:
worksheets("hr-calc").activate lrow = cells(cells.rows.count, "a").end(xlup).row 6 step -1 if cells(lrow, "a") <> cells(lrow - 1, "a") rows(lrow).entirerow.insert rows(lrow).entirerow.insert rows(lrow).entirerow.insert rows(lrow).entirerow.insert end if next lrow
a neater way use autofilter on table
(the code assumes column sorted integer id - seems case image)
sub insertrowsbetweenincrements() dim ws worksheet: set ws = worksheets("hr-calc") dim headerrow long: headerrow = 4 application.screenupdating = false dim lastrow long: lastrow = ws.columns(1).find("*", _ searchorder:=xlbyrows, searchdirection:=xlprevious).row dim lastcol long: lastcol = ws.cells.find("*", _ searchorder:=xlbycolumns, searchdirection:=xlprevious).column dim tbl range: set tbl = ws.range(cells(headerrow, 1), cells(lastrow, lastcol)) dim long, j long = ws.cells(lastrow, 1).value 1 step -1 tbl.autofilter field:=1, criteria1:=i j = tbl.specialcells(xlcelltypevisible).specialcells(xlcelltypelastcell).row tbl.autofilter if j <> headerrow , j < lastrow _ ws.rows(j + 1 & ":" & j + 4).insert shift:=xldown next application.screenupdating = true end sub
Comments
Post a Comment