excel vba - Copy rows to separate sheets based on value in a particular column -
the group column in table contains value either 1 or 2 . want copy row value 1 sheet2 , rows values 2 sheet3 using button. should show error message if cells left blank or if value neither 1 nor 2.
roll no meter width group
112 150 130 1
since new coding have following approach
check if cell empty , generate error message
check if cell contains value other 1 or 2 , generate error message
- finally copy row values 1 sheet2 , rest in sheet3
i need in doing effective way. have keep size of file down
enter code here
private sub commandbutton2_click()
dim integer p = sheet1.range("l1").value 'no. of filled cells in range application.displayalerts = false sheet1.activate ''checking if range empty = 29 p + 29 if sheet1.range("l" & i).value = "" msgbox ("please enter shrinkage group cell no. l" & i) range("l" & i).activate end end if next '' checking if range contains values other 1 or 2 = 29 p + 29 if sheet1.range("l" & i).value <> 1 , sheet1.range("l" & i).value <> 2 msgbox ("shade group not exist cell no. l" & i) range("l" & i).activate end end if next ' sort based on group range("a29:l300").sort _ key1:=range("l29"), header:=xlyes 'count number of rolls in group 1 dim x, y long dim a, b integer x = range("l" & rows.count).end(xlup).row if x < 29 x = 29 = application.worksheetfunction.countif(range("l12:l" & x), 1) + 28 range("m1").value = ' count number of rolls in group 2 y = range("l" & rows.count).end(xlup).row if y < 29 y = 29 b = application.worksheetfunction.countif(range("l12:l" & x), 2) range("n1").value = b '' copying groupwise different sheet sheet1.range("a29", "l" & a).copy sheet2.range("a5").pastespecial xlpasteall sheet2.range("a5").pastespecial xlpastevaluesandnumberformats '' copying group 2 sheet1.range("a" & + 1, "l" & + b).copy sheet5.range("a5").pastespecial xlpasteall sheet5.range("a5").pastespecial xlpastevaluesandnumberformats
end sub
create named ranges source data , rows after want copied. in example i've used "source", "range1" , "range2". following code copies source data appropriate place:
sub copydata() dim source range, range1 range, range2 range dim r range set source = range("source") set range1 = range("range1") set range2 = range("range2") each r in source.rows if r.cells(1, 4).value = 1 copyrow r, range1 elseif r.cells(1, 4).value = 2 copyrow r, range2 else ' handle error here end if next r end sub sub copyrow(data range, targetrange range) set targetrange = targetrange.resize(targetrange.rows.count + 1, targetrange.columns.count) = 1 3 targetrange.cells(targetrange.rows.count, i).value = data.cells(1, i).value next end sub
there's more elegant way of doing involving array formulae, should trick.
for validating each cell contains "1" or "2", can include additional code i've put comment, you'd better off handling data validation.
Comments
Post a Comment