Extending VB Code to Fill Excel Cells If Column Name Matches Data Validation -

we've got vb code in excel workbook @ present allows data validation (list dropdown) options multiple selected , each dropdown item selected list, outputs option @ end of row, 1 option per column.

i.e: selecting apples, bananas , cherries drop down list output apples | bananas | cherries (where | column separator) @ end of row first cells empty.

the code have is:-

option explicit private sub worksheet_change(byval target range) on error goto exithandler  dim rngdv range dim icol integer  if target.count > 1 goto exithandler  on error resume next set rngdv = cells.specialcells(xlcelltypeallvalidation) on error goto exithandler if rngdv nothing goto exithandler if intersect(target, rngdv) nothing    'do nothing else   application.enableevents = false    if target.column = 3     if target.value = "" goto exithandler     if target.validation.value = true      icol = cells(target.row, columns.count).end(xltoleft).column + 1      cells(target.row, icol).value = target.value    else      msgbox "invalid entry"      target.activate     end if   end if end if  exithandler:   application.enableevents = true  end sub 

what modify in vb code however, instead of filling cells @ end of row data validations selected. fill cell under column column heading matches option selected dropdown.

i.e: apples selected in dropdown fill cell on row under column labelled 'apples'. cherries selected in dropdown fill cell on row under column labelled 'cherries'. ideally, fill, colour cell or put x there rather repeat name of item selected.

if advise on need modify in above code, appreciated.

i have modified code requested, iterates through column headers find correct column changes background color of appropriate cell.
update: added check prevent infinite loop.

private sub worksheet_change(byval target range) on error goto exithandler  dim rngdv range dim icol integer, icolumnheaderrow integer icolumnheaderrow = 3 'change if header row changes  if target.count > 1 goto exithandler  on error resume next set rngdv = cells.specialcells(xlcelltypeallvalidation) on error goto exithandler if rngdv nothing goto exithandler if not intersect(target, rngdv) nothing     application.enableevents = false     if target.column = 3         if target.value = "" goto exithandler         if target.validation.value = true             'iterate through column headers find matching column             icol = (target.column + 1)             until cells(icolumnheaderrow, icol).value = target.value                 icol = icol + 1                 'if we've hit blank cell in header row, exit                  '(also prevent infinite loop here)                 if cells(icolumnheaderrow, icol).value = "" goto exithandler             loop              'set fill color of appropriate cell             cells(target.row, icol).interior                 .pattern = xlsolid                 .patterncolorindex = xlautomatic                 .themecolor = xlthemecoloraccent6                 .tintandshade = 0.599993896298105                 .patterntintandshade = 0             end         else             msgbox "invalid entry"             target.activate         end if     end if end if  exithandler:     application.enableevents = true end sub