EXCEL VBA: Compare then Update/change, remove and add between 2 sheets -


i'm comparing 2 worksheets in same workbook, row row (and each cell of row) code able identify of row has been changed(change), if doesn't exist in second sheet show removed (remove), or if exist in second sheet needs added (add). tab in work sheet are:

original \ updated \ changes

what trying achieve create fourth 1 (final) changes applied, before there found problems code (btw source , template found at: here)it works great(with remove , add), when using great number of registries (hundreds) of them, flagged changes doesn't display right values, , sometimes, reworking in same tabs , trying apply the macro again gets error @ marked line(*).

i.e.: original \ updated \ changed

car_01 |500| ms \ car_01 |750 |ms \ car_01| 15.5| ms

at first approach problem thinking related type of parameter @ cells vs input has in macro far haven't found right type (already have try it: general, number , text). scope in solutions of how display fourth sheet , problem values types appreciate it.

sub comparesheets() application.screenupdating = false  ' constants '  worksheets & ranges '   original const kswsoriginal = "original" const ksoriginal = "originaltable" const ksoriginalkey = "originalkey" '   updated const kswsupdated = "updated" const ksupdated = "updatedtable" const ksupdatedkey = "updatedkey" '   changes const kswschanges = "changes" const kschanges = "changestable" '  labels const kschange = "change" const ksremove = "remove" const ksadd = "add" ' ' declarations dim rngo range, rngok range, rngu range, rnguk range, rngc range dim c range dim long, j long, lchanges long, lrow long, bequal boolean ' ' start set rngo = worksheets(kswsoriginal).range(ksoriginal) '(*)here gets marked error of debugger set rngok = worksheets(kswsoriginal).range(ksoriginalkey) set rngu = worksheets(kswsupdated).range(ksupdated) set rnguk = worksheets(kswsupdated).range(ksupdatedkey) set rngc = worksheets(kswschanges).range(kschanges) rngc     if .rows.count > 1         range(.rows(2), .rows(.rows.count)).clearcontents         range(.rows(2), .rows(.rows.count)).font.colorindex = xlcolorindexautomatic         range(.rows(2), .rows(.rows.count)).font.bold = false     end if end ' ' process lchanges = 1 '  1st pass: updates & deletions rngok     = 1 .rows.count         set c = rnguk.find(.cells(i, 1).value, , xlvalues, xlwhole)         if c nothing             ' deletion             lchanges = lchanges + 1             rngc.cells(lchanges, 1).value = ksremove             j = 1 rngo.columns.count                 rngc.cells(lchanges, j + 1).value = rngo.cells(i, j).value                 rngc.cells(lchanges, j + 1).font.color = vbred                 rngc.cells(lchanges, j + 1).font.bold = true             next j         else             bequal = true             lrow = c.row - rnguk.row + 1             j = 1 rngo.columns.count                 if rngo.cells(i, j).value <> rngu.cells(lrow, j).value                     bequal = false                     exit                 end if             next j             if not bequal                 ' change                 lchanges = lchanges + 1                 rngc.cells(lchanges, 1).value = kschange                 j = 1 rngo.columns.count                     if rngo.cells(i, j).value = rngu.cells(lrow, j).value                         rngc.cells(lchanges, j + 1).value = rngo.cells(i, j).value                     else                         rngc.cells(lchanges, j + 1).value = rngu.cells(i, j).value                         rngc.cells(lchanges, j + 1).font.color = vbmagenta                         rngc.cells(lchanges, j + 1).font.bold = true                     end if                 next j             end if         end if     next end '  2nd pass: additions rnguk     = 1 .rows.count         set c = rngok.find(.cells(i, 1).value, , xlvalues, xlwhole)         if c nothing             ' addition             lchanges = lchanges + 1             rngc.cells(lchanges, 1).value = ksadd             j = 1 rngu.columns.count                 rngc.cells(lchanges, j + 1).value = rngu.cells(i, j).value                 rngc.cells(lchanges, j + 1).font.color = vbblue                 rngc.cells(lchanges, j + 1).font.bold = true             next j         end if     next end ' ' end worksheets(kswschanges).activate rngc.cells(2, 3).select set rngc = nothing set rnguk = nothing set rngu = nothing set rngok = nothing set rngo = nothing beep ' application.screenupdating = true end sub 

as additional note, test different methods apply solution (lookup, ...) far best approach.


i have located error of change status, , related absolute reference in loop, instance: original tab has value in row 505 parameter car_red has value of 23 updated tab has same parameter (car_red) in row 575 value 27 code notice difference, instead of copy new value, value updated tab in row 505 (as original tab location of value), guess somehow need variable catch new value of parameter use reference updated tab.

there error in extract below first listing.

rngc.cells(lchanges, j + 1).value = rngu.cells(i, j).value 

should

rngc.cells(lchanges, j + 1).value = rngu.cells(lrow, j).value  

as i refers row position in original file while lrow refers matching entry row position in update file.

for j = 1 rngo.columns.count    if rngo.cells(i, j).value = rngu.cells(lrow, j).value       rngc.cells(lchanges, j + 1).value = rngo.cells(i, j).value    else       rngc.cells(lchanges, j + 1).value = rngu.cells(i, j).value       rngc.cells(lchanges, j + 1).font.color = vbmagenta       rngc.cells(lchanges, j + 1).font.bold = true    end if next j 

Comments

Popular posts from this blog

python - mat is not a numerical tuple : openCV error -

c# - MSAA finds controls UI Automation doesn't -

wordpress - .htaccess: RewriteRule: bad flag delimiters -