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

  1. check if cell empty , generate error message

  2. check if cell contains value other 1 or 2 , generate error message

  3. 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

Popular posts from this blog

javascript - How to get current YouTube IDs via iMacros? -

c# - Maintaining a program folder in program files out of date? -

emulation - Android map show my location didn't work -