regex - Excel macro to replace part of string -

i'm having trouble replacing part of string in range of data includes comments.

where id numbers appears, need replace middle of id numbers xs (e.g. 423456789 become 423xxx789). ids ever start 4 or 5 , other number should ignored may necessary other purposes.

sadly, because these comments data inconsistently formatted adds level of complexity.

representative data following:

523 123 123 523123123 id 545 345 345 mr. jones primary id 456456456 mrs. brown mr. smith's id 567567567 

i need code replace middle 3 digits of id number , leave rest of cell intact

id 545 345 345 mr. jones  primary id 456456456 mrs. brown 

becomes (with or without spaces around xs)

id 545 xxx 345 mr. jones  primary id 456xxx456 mrs. brown 

the regex have finding lines ids successfully, , works nicely cells no other text. sadly, other cells not replace 3 digits need replacing , makes mess of data cell. code below works first 2 cells above, doesn't work remainder. please help.

sub fixids()  dim regex new regexp     dim strpattern string: strpattern = "([4][0-9]{2})([^a-za-z0-9_]?[0-9]{3})([^a-za-z0-9_]?[0-9]{3})|([5][0-9]{2})([^a-za-z0-9_]?[0-9]{3})([^a-za-z0-9_]?[0-9]{3})" dim strreplace string: strreplace = "" dim strinput string dim myrange range dim newpan string dim aproblem string dim masked long dim problems long dim total long  'set regex config/settings/properties     regex         .global = true         .multiline = true         .ignorecase = false         .pattern = strpattern ' sets regex pattern match pattern above     end  set myrange = selection  msgbox ("the macro start masking ids identified in selected cells only.") ' start masking ids     each cell in myrange         total = total + 1         ' check cell long enough possibly id , isn't masked         while len(cell.value) > 8 , mid(cell.value, 5, 1) <> "x" , cell.value <> aproblem             if strpattern <> ""                  cell.numberformat = "@"                 strinput = cell.value                 newpan = left(cell.value, 3) & "xxx" & right(cell.value, 3)                 strreplace = newpan  ' depending on data, fix                 if regex.test(strinput)                     cell.value = newpan                     masked = masked + 1                 else                     ' adds cell value variable allow macro move past cell                     aproblem = cell.value                     problems = problems + 1                     ' once macro trusted not loop forever, message box can removed                     ' msgbox ("problem. regex fail? bad data = " & aproblem)                 end if             end if         loop     next cell  ' done msgbox ("ids masked" & vbcr & vbcr & "total cells highlighted (including blanks) = " & total & vbcr & "cells masked = " & masked & vbcr & "problem cells = " & problems) end sub 

i removed do... while loop , changed logics in for each cell in myrange code process matches 1 one , create specific replacements if have non-empty value in first or fourth capturing group (we can choose values choose replacement then).

for each cell in myrange     total = total + 1     ' check cell long enough possibly id , isn't masked          if strpattern <> ""              cell.numberformat = "@"             strinput = cell.value              ' depending on data, fix             if regex.test(strinput)               set rmatch = regex.execute(strinput)               k = 0 rmatch.count - 1                  toreplace = rmatch(k).value                  if len(rmatch(k).submatches(0)) > 0 ' first pattern worked                    strreplace = rmatch(k).submatches(0) & "xxx" & trim(rmatch(k).submatches(2))                  else ' second alternative in place                    strreplace = rmatch(k).submatches(3) & "xxx" & trim(rmatch(k).submatches(5))                  end if                  cell.value = replace(strinput, toreplace, strreplace)                  masked = masked + 1                next k             else                 ' adds cell value variable allow macro move past cell                 aproblem = cell.value                 problems = problems + 1                 ' once macro trusted not loop forever, message box can removed                 ' msgbox ("problem. regex fail? bad data = " & aproblem)             end if         end if  next cell 

here result: