Updating data in Excel workbook with data in an other workbook -
i have workbook called price list, contain several worksheets each worksheet in same format contain different classifications of products. format of work sheet folows:
b c d1 prc description unit price
2 a001 product1 each 20.00
3 d001 product2 l 5.00
4 h001 product3 rol 4.00
every month updated price list exel workbook.
in past got information above changed @ supplier , receive "product code" "bar-code" , "price"
i need update "price-list" matching product code in "update" 1 in price list. compare price, if price differs should change price in "price-list" of "update"
if posible should delete line in "update" know if there new products , delete line in "price-list" if product code not found in "update", discontinued products.
the "update" contains 12000 lines
is there easy way in doing it?
edited include comments , code op
i wrote code i'm not clued vba.
sub updatemisilanious_original() ' updatemisilanious macro ' update misilanious list 'the variable active line in misilanious dim almis integer almis = 4 'the variable active line in update dim alup integer alup = 2 'the varible product code of misilanious dim prcmis string 'the varible product code of update dim prcup string 'the temp varible price dim newprice currency 'read first product code in pricelist prcmis = worksheets("misilanious").range("a" & almis).value 'start loop update products while prcmis <> "" prcmis = worksheets("misilanious").range("a" & almis).value prcup = worksheets("update").range("a" & alup).value if prcmis = prcup 'copy price update pricelist newprice = worksheets("update").range("c" & alup).value worksheets("misilanious").range("e" & almis) = newprice 'add 1 active line of price list almis = almis + 1 'reset active line of update alup = 2 else: 'loop through update untilmaching product code found until prcmis = prcup alup = alup + 1 prcup = worksheets("update").range("a" & alup).value loop newprice = worksheets("update").range("c" & alup).value worksheets("misilanious").range("e" & almis) = newprice 'add 1 active line of price list almis = almis + 1 'reset active line of update alup = 2 end if loop msgbox "update done" end sub
good attempt @ writing code, short comment it:
this part loop endlessly if product discontinued…
'loop through update untilmaching product code found until prcmis = prcup alup = alup + 1 prcup = worksheets("update").range("a" & alup).value loop the solution provided below, loop through products in price list instead of looping again through update, finds matching record. runs comparison of price list vs. update identifying new prices , discontinued products, runs second comparison update price list in order add new products. have @ procedure below , suggested readings, hope encourage continue working on automating tedious , repetitive daily tasks.
this solutions uses these 3 worksheets:
- update: contains latest price update products. may include new products, “discontinued” products not included in list. data continuous range of cells starting @
e7, delimited blank cells. - price list: contains list of products respective price , other associated data. data continuous range of cells starting @
c6, delimited blank cells. - discontinued: contains list of discontinued products. data continuous range of cells starting @
b2, delimited blank cells. worksheet created procedure if not present.
this code runs comparison of products between price list , update worksheets (both ways) , updates new prices, adds new products , deletes discontinued products in price list data, track of updates , keeping list of discontinued products in separated worksheet.
as code use resources might unknown user, have added indications of purpose , suggested pages extended reading , understanding, nevertheless let me know of question might have code.
application object (excel), for...next statement, msgbox function,
range object (excel), variables & constants, with statement,
worksheets object (excel), worksheetfunction object (excel)
option explicit sub update_miscellaneous() rem constants hold starting cell of data ranges (update required) 'see [variables & constants] const kiniplst string = "c6" const kiniupdt string = "e7" const kinidisc string = "b2" rem declare objects variables 'see [range object (excel)] dim rupdt range, rmisc range, rdisc range rem declare process variables dim sprod string, dpric double, dpold double dim wsh worksheet, rng range dim bprodupdt byte, bpricupdt byte dim bprod byte, bpric byte, bpold byte, bpstt byte dim lrow0 long, lrow1 long, lnew long dim ttme date, snow string rem application settings improve performance 'see [application object (excel)] application.screenupdating = false application.displayalerts = false application.enableevents = false rem set time & date ttme = snow = format(now, " dd-mmm-yy hh:mm") rem set objects 'see [with statement] thisworkbook set rupdt = .worksheets("update").range(kiniupdt).currentregion set rmisc = .worksheets("price list").range(kiniplst).currentregion on error goto wshadd set rdisc = .worksheets("discontinued").range(kinidisc).currentregion on error goto 0 set rdisc = rdisc.rows(1).offset(rdisc.rows.count) end rem set field position - updated 'see [worksheetfunction object (excel)] rupdt rem set field position 'using excel worksheet functions in vba bprodupdt = worksheetfunction.match("product code", .rows(1), 0) 'can used application bpricupdt = application.match("price", .rows(1), 0) rem set body range set rupdt = .offset(1, 0).resize(-1 + .rows.count) end rem set field position - miscellaneous rmisc rem set autofilter off if not .worksheet.autofilter nothing .autofilter rem set field position bprod = worksheetfunction.match("prc", .rows(1), 0) bpric = worksheetfunction.match("price", .rows(1), 0) bpold = worksheetfunction.match("price.old", .rows(1), 0) bpstt = worksheetfunction.match("status", .rows(1), 0) rem set body range set rmisc = .offset(1, 0).resize(-1 + .rows.count) end rem update current products rmisc rem set latest price 'see [for...next statement] lrow0 = 1 .rows.count sprod = .cells(lrow0, bprod).value2 dpold = .cells(lrow0, bpric).value2 rem latest price lrow1 = 0 on error resume next lrow1 = worksheetfunction.match(sprod, rupdt.columns(bprodupdt), 0) on error goto 0 if lrow1 <> 0 rem prices comparison dpric = rupdt.cells(lrow1, bpricupdt).value2 if dpric <> dpold rem new price .cells(lrow0, bpold).value = dpold .cells(lrow0, bpric).value = dpric .cells(lrow0, bpstt).value = "price change" & snow end if else rem product discontinued .cells(lrow0, bpold).value = dpold .cells(lrow0, bpric).clearcontents .cells(lrow0, bpstt).value = "discontinued" & snow end if: next: end rem set new products lnew = rmisc.rows.count rupdt lrow0 = 1 .rows.count sprod = .cells(lrow0, bprod).value2 dpric = .cells(lrow0, bpricupdt).value2 rem new product lrow1 = 0 on error resume next lrow1 = worksheetfunction.match(sprod, rmisc.columns(bprodupdt), 0) on error goto 0 if lrow1 = 0 rem add new product lnew = 1 + lnew rmisc .cells(lnew, bprod).value = sprod .cells(lnew, bpric).value = dpric .cells(lnew, bpstt).value = "!new product" & snow end with: end if: next: end rem reset range misc if lnew <> rmisc.rows.count set rmisc = rmisc.currentregion set rmisc = rmisc.offset(1, 0).resize(-1 + rmisc.rows.count) debug.print xlpasteformats, now, rmisc.rows(1).copy rmisc.pastespecial paste:=xlpasteformats application.cutcopymode = false debug.print end if rem move discontinued records rmisc rem sort status 'sort property of worksheet object .worksheet.sort .sortfields.clear .sortfields.add key:=rmisc.columns(bpstt), _ sorton:=xlsortonvalues, order:=xlascending, dataoption:=xlsortnormal .setrange rmisc .header = xlyes .matchcase = false .orientation = xltoptobottom .sortmethod = xlpinyin .apply end rem set autofilter .currentregion.autofilter rem filter status\discontinued .autofilter field:=bpstt, criteria1:="=*discontinued*" on error resume next set rng = .specialcells(xlcelltypevisible) on error goto 0 rem set autofilter off if not .worksheet.autofilter nothing .autofilter rem work discontinued records if not rng nothing rem add discontinued records rdisc.resize(rng.rows.count).value = rng.value2 rdisc.currentregion.columns.autofit application.goto rdisc.worksheet.cells(1), 1 application.goto rdisc.cells(1) rem delete discontinued records 'rng.entirerow.delete 'use line if no other data in worksheet rng.delete shift:=xlup 'use line if there other data in worksheet end if: end rem sort remaining records product rmisc.worksheet.sort .sortfields.clear .sortfields.add key:=rmisc.columns(bprod), _ sorton:=xlsortonvalues, order:=xlascending, dataoption:=xlsortnormal .setrange rmisc .header = xlyes .matchcase = false .orientation = xltoptobottom .sortmethod = xlpinyin .apply end rem restate application settings application.goto rmisc.worksheet.cells(1), 1 application.goto rmisc.cells(1) application.enableevents = true application.displayalerts = true application.screenupdating = true 'see [msgbox function] rem process completed msgbox "update completed in " & format(now - ttme, "hh : mm : ss.001"), _ vbapplicationmodal + vbinformation + vbokonly, _ "product price update" exit sub wshadd: 'see [worksheets object (excel)] rem add worksheet discontinued thisworkbook set wsh = .sheets.add(after:=.sheets(.sheets.count)) end wsh.name = "discontinued" wsh.range(kinidisc).resize(, rmisc.columns.count).value = rmisc.rows(1).value2 resume end sub 
fig.1 price list before update
fig.2 update data
fig. 3 price list after update
fig. 4 discontinued after update
Comments
Post a Comment