excel - Cross Referencing a sheet to a master data sheet -
i have macro allows cross reference "sheet2" in "sheet1" where"sheet1" sheet contain master data. idea here compare sheet 2 master data , see if matches. problem macro compares within limited amount of range. wondering how make more dynamic or flexible should add column used cross reference.
here sample of sheets.
example: sheet1 name id class name taken? john riley 0001 painting yes bob johnson 0101 painting no matthew ward 1111 math yes sheet 2: name id class name taken? matthew ward 1111 math yes bob johnson 0101 painting no warren renner 2222 drama no john riley 0001 painting yes what need change in macro make compare should add additional columns in sheets?
example: sheet1 name id class name taken? date taken john riley 0001 painting yes 8/25/13 bob johnson 0101 painting no matthew ward 1111 math yes 9/20/10 sheet 2: name id class name taken? date taken matthew ward 1111 math yes 9/20/10 bob johnson 0101 painting no - warren renner 2222 drama no - john riley 0001 painting yes 8/25/13 code:
sub compare_data() dim rngdata2 range dim rngdata1 range dim cell2 range dim cell1 range dim rlastcell range set rngdata2 = worksheets("sheet2").range("b3", worksheets("sheet2").range("b65536").end(xlup)) set rngdata1 = worksheets("sheet1").range("b3", worksheets("sheet1").range("b65536").end(xlup)) ' check customers in "sheet2" "sheet1" each cell2 in rngdata2 each cell1 in rngdata1 cell1 if .offset(0, 0) = cell2.offset(0, 0) , _ .offset(0, 1) = cell2.offset(0, 1) , _ .offset(0, 2) = cell2.offset(0, 2) , _ .offset(0, 3) = cell2.offset(0, 3) .offset(0, -1).range("a1:f1").interior.colorindex = 3 cell2.offset(0, 4) = .offset(0, 4) end if end next cell1 next cell2 end sub
here 1 way make macro accept number of columns , increase compare efficiency. assuming sheet 1 sorted id, first thing sort sheet2 id. , changing compare code speed compare process. note: if have same id # multiple classnames need sort sheets 1 & 2 col b , c compare process work. second thing change compare code, code compares every row on sheet1 every row on sheet2 rows in sheets, whether contain data or not, horribly, horribly inefficient.
sub compare_data() dim firstrow long, firstcol long, lastrow long, lastcol long dim sortsheet2 range dim s1lastrow double, s2lastrow double activeworkbook.worksheets("sheet2").select ' find used range, name it, sort firstrow = cells.find(what:="*", searchdirection:=xlnext, searchorder:=xlbyrows).row firstcol = cells.find(what:="*", searchdirection:=xlnext, searchorder:=xlbycolumns).column lastrow = cells.find(what:="*", searchdirection:=xlprevious, searchorder:=xlbyrows).row lastcol = cells.find(what:="*", searchdirection:=xlprevious, searchorder:=xlbycolumns).column set sortsheet2 = range(cells(firstrow, firstcol), cells(lastrow, lastcol)) sortsheet2.select activeworkbook.worksheets("sheet2").sort.sortfields.clear activeworkbook.worksheets("sheet2").sort.sortfields.add key:=range(cells(1, "b"), cells(lastrow, "b")), _ sorton:=xlsortonvalues, order:=xlascending, dataoption:=xlsortnormal activeworkbook.worksheets("sheet2").sort .setrange range("sortsheet2") .header = xlyes .matchcase = false .orientation = xltoptobottom .sortmethod = xlpinyin .apply end range("a1").select dim s1id variant, s2id variant, s1rowcntr long, s2rowcntr long, colcnt long s1rowcntr = 1 s2rowcntr = 1 colcnt = 3 ' starting @ col c compare function application.screenupdating = false 'set true troubleshooting activeworkbook.worksheets("sheet1").select until isempty(activecell) ' loop thru sheet 1 id numbers s1rowcntr = s1rowcntr + 1 range(cells(s1rowcntr, colcnt - 1), cells(s1rowcntr, colcnt - 1)).select s1data = activecell.address s1id = range(s1data).value activeworkbook.worksheets("sheet2").activate s2rowcntr = s2rowcntr + 1 range(cells(s2rowcntr, "b"), cells(s2rowcntr, "b")).activate s2data = activecell.address s2id = range(s2data).value if s2id = s1id ' done = equals(colcnt, s1rowcntr, s2rowcntr, lastcol) else until s1id = s2id or s2id = "" s2rowcntr = s2rowcntr + 1 range(cells(s2rowcntr, "b"), cells(s2rowcntr, "b")).select s2data = activecell.address s2id = range(s2data).value loop if s2id = "" 'do nothing elseif s1id = s2id done = equals(colcnt, s1rowcntr, s2rowcntr, lastcol) end if end if colcnt = 3 activeworkbook.worksheets("sheet1").select loop activeworkbook.worksheets("sheet1").select range("a1").select end sub function equals(byval colcnt long, byval s1rowcntr long, byval s2rowcntr long, byval lastcol long) same = true 'if values same continue compare columns ' if value false, stop , highlight, again efficient until colcnt > lastcol or same = false activeworkbook.worksheets("sheet1").select range(cells(s1rowcntr, colcnt), cells(s1rowcntr, colcnt)).select s1data = activecell.address class = range(s1data).value activeworkbook.worksheets("sheet2").select range(cells(s2rowcntr, colcnt), cells(s2rowcntr, colcnt)).select s2data = activecell.address taken = range(s2data).value if taken = class same = true else activeworkbook.worksheets("sheet1").select range(cells(s1rowcntr, "a"), cells(s1rowcntr, lastcol)).select selection .interior.colorindex = 3 end same = false end if colcnt = colcnt + 1 loop end function
Comments
Post a Comment