excel - Subscript out of range error at Next Row -
sub changecolor() dim rcell range dim finalrow long, x long dim nextrow long sheet1 each rcell in .range("h2", .cells(.rows.count, 8).end(xlup)).cells if rcell.value > date + 1 rcell.interior.color = vbred elseif rcell.value < date - 15 rcell.interior.color = vbyellow else rcell.interior.color = vbgreen end if next rcell finalrow = cells(rows.count, 1).end(xlup).row ' loop through each row x = 2 finalrow ' decide if copy based on column d if ((cells(x, 8).interior.color = vbred) or (cells(x, 8).interior.color = vbyellow)) cells(x, 1).resize(1, 33).copy sheets("sheet2").select nextrow = cells(rows.count, 1).end(xlup).row + 1 cells(nextrow, 1).select activesheet.paste sheets("sheet1").select elseif ((cells(x, 8).interior.color = vbgreen)) cells(x, 1).resize(1, 33).copy sheets("sheet3").select nextrow = cells(rows.count, 1).end(xlup).row + 1 cells(nextrow, 1).select activesheet.paste sheets("sheet1").select end if next x end end sub
i getting subscript out of range error @ beginning of next row. in code, trying separate list using highlighted color of cell. in sheet1, if column has either red or yellow, should copy sheet2. if has green copy sheet3.
try :
sub changecolor() dim rcell range, _ finalrow long, _ x long, _ nextrow long sheets("sheet1") each rcell in .range("h2", .cells(rows.count, "h").end(xlup)).cells if rcell.value > date + 1 rcell.interior.color = vbred elseif rcell.value < date - 15 rcell.interior.color = vbyellow else rcell.interior.color = vbgreen end if next rcell finalrow = .cells(rows.count, 1).end(xlup).row 'loop through each row x = 2 finalrow ' decide if copy based on column d if ((.cells(x, 8).interior.color = vbred) or (.cells(x, 8).interior.color = vbyellow)) nextrow = sheets("sheet2").cells(rows.count, 1).end(xlup).row + 1 .cells(x, 1).resize(1, 33).copy destination:=sheets("sheet2").cells(nextrow, 1).paste elseif (.cells(x, 8).interior.color = vbgreen) nextrow = sheets("sheet3").cells(rows.count, 1).end(xlup).row + 1 .cells(x, 1).resize(1, 33).copy destination:=sheets("sheet3").cells(nextrow, 1).paste end if next x end end sub
or this
for x = 2 finalrow ' decide if copy based on column d if ((cells(x, 8).interior.color = vbred) or (cells(x, 8).interior.color = vbyellow)) cells(x, 1).resize(1, 33).copy nextrow = sheets("sheet2").cells(rows.count, 1).end(xlup).row + 1 activesheet.cells(nextrow, 1).paste elseif ((cells(x, 8).interior.color = vbgreen)) cells(x, 1).resize(1, 33).copy nextrow = sheets("sheet3").cells(rows.count, 1).end(xlup).row + 1 activesheet.cells(nextrow, 1).paste end if next x sheets("sheet1").select
Comments
Post a Comment