excel vba - VBA for duplicate rows -


i have sheet of columns. want compare data in multiple columns, , return flag in column indicate rows duplicates. found little code online meant checking 1 column of data, , have far been unsuccessful in being able tweek multiple columns. final code need @ specific columns define later moment sheet follows: staffnumber calltype
1 a
2 b
1 a
4 d
5 e
6 f
7 g
8 h
1 a
2 c
1 z
6 p

the col labelled staff number. col b labelled calltype. in col c want flag entered against row.

my code follows:

sub duplicateissue()

dim last_staffnumber long dim last_calltype long  dim match_staffnumber long dim match_calltype long  dim staffnumber long dim calltype long  last_staffnumber = range("a65000").end(xlup).row last_calltype = range("b65000").end(xlup).row  staffnumber = 1 last_staffnumber calltype = 1 last_calltype      'checking if staff number cell having item, skipping if blank.         if cells(staffnumber, 1) <> " "          'getting match index number value of cell             match_staffnumber = worksheetfunction.match(cells(staffnumber, 1), range("a1:a" & last_staffnumber), 0)              if cells(calltype, 2) <> " "              match_calltype = worksheetfunction.match(cells(calltype, 2), range("b1:b" & last_calltype), 0)                  'if match index not equals current row number, duplicate value                 if staffnumber <> match_staffnumber , calltype <> match_calltype                     'printing label in column c                     cells(staffnumber, 3) = "duplicate"                 end if             end if         end if next next 

end sub

my problem when col 1 duplicate macro enter "duplicate" col c, , not checking if value of col b same. appreciated.

try code:

.

option explicit  public sub showduplicaterows()     const sheet_name    string = "sheet1"     const last_col      long = 3 ' <<<<<<<<<<<<<<<<<< update last column     const first_row     long = 2     const first_col     long = 1     const dupe          string = "duplicate"     const case_sensitive byte = 1                    'matches upper & lower      dim includedcolumns object     set includedcolumns = createobject("scripting.dictionary")     includedcolumns         .add 1, ""  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 1 dupe criteria         .add 3, ""  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 3 dupe criteria     end     dim searchrng       range     dim memarr          variant     dim               long     dim j               long     dim unique          string     dim totalrows       long     dim totalcols       long     dim totalurcols     long     dim valdict         object     set valdict = createobject("scripting.dictionary")      if case_sensitive = 1         valdict.comparemode = vbbinarycompare     else         valdict.comparemode = vbtextcompare     end if     thisworkbook.sheets(sheet_name)         totalrows = .usedrange.rows.count               'get last used row on sheet         totalurcols = .usedrange.columns.count          'get last used col on sheet         set searchrng = .range( _                                 .cells(first_row, first_col), _                                 .cells(totalrows, last_col) _                                 )         if last_col < totalurcols                         .range( _                                 .cells(first_row, last_col + 1), _                                 .cells(first_row, totalurcols) _                                 ).entirecolumn.delete   'delete columns         end if     end      memarr = searchrng.resize(totalrows, last_col + 1)  'entire range data mem      = 1 totalrows                              'each row, without header         j = 1 last_col                           'each col             if includedcolumns.exists(j)                 unique = unique & searchrng(i, j)       'concatenate values on same row             end if         next         if valdict.exists(unique)                  'check if entire row exists             memarr(i, last_col + 1) = dupe              'if does, flag in last col         else             valdict.add key:=unique, item:=i            'else add dictionary         end if         unique = vbnullstring     next     searchrng.resize(totalrows, last_col + 1) = memarr  'entire memory sheet end sub 

.

result:

duplicaterows.jpg


Comments

Popular posts from this blog

c# - Validate object ID from GET to POST -

node.js - Custom Model Validator SailsJS -

php - Find a regex to take part of Email -