Please help to write a Macro?

[Kazdima]

HI guys,
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Would you please help me to write a Macro to extract the name from the “description” in one cell, compare and match it with a list of names in another column, and put a first and last name in another cell of the same row?
For example (400 Rows with the description in Column F ).
<TABLE class=MsoNormalTable style="MARGIN: auto auto auto 4.6pt; WIDTH: 167pt; BORDER-COLLAPSE: collapse; mso-yfti-tbllook: 1184; mso-padding-alt: 0in 5.4pt 0in 5.4pt" cellSpacing=0 cellPadding=0 width=223 border=0><TBODY><TR style="HEIGHT: 13.5pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes"><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 167pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 13.5pt; BACKGROUND-COLOR: transparent" vAlign=top noWrap width=223>1.M. Atahak-Nov26-28-reserv#14
</TD></TR><TR style="HEIGHT: 13.5pt; mso-yfti-irow: 1"><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 167pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 13.5pt; BACKGROUND-COLOR: transparent" vAlign=top noWrap width=223>2.M.Albert-Nov15-18-reserv#9928
</TD></TR><TR style="HEIGHT: 13.5pt; mso-yfti-irow: 2"><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 167pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 13.5pt; BACKGROUND-COLOR: transparent" vAlign=top noWrap width=223>3.J.Ninark-reserve #136491 Nov22-
</TD></TR><TR style="HEIGHT: 13.5pt; mso-yfti-irow: 3; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 167pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 13.5pt; BACKGROUND-COLOR: transparent" vAlign=top noWrap width=223>4.03-DT377825-Mary Romanczak-201
Etc.
</TD></TR></TBODY></TABLE>
In Column J I have a list of first and Last Names:
Row 5. Marie Atahak
Row 12: Michael Albert
Row 14 Jennifer Ninark
I would like to populate corresponding names into rows 1,2,3 of Column G.
Also, is it possible to create a Macro to create a table for each employee, having the following titles?
<TABLE class=MsoNormalTable style="MARGIN: auto auto auto 4.6pt; WIDTH: 364pt; BORDER-COLLAPSE: collapse; mso-yfti-tbllook: 1184; mso-padding-alt: 0in 5.4pt 0in 5.4pt" cellSpacing=0 cellPadding=0 width=485 border=0><TBODY><TR style="HEIGHT: 21pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes"><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 55.25pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=74>Department<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 43.1pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=57>Expense account<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 54.45pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=73>Transaction Type<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 47.3pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=63>Document type<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 29.6pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=39>Date<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 52.9pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=71>Description<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 39.45pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=53>Names<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 41.95pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=56>

Amount<o></o>​

</TD></TR><TR style="HEIGHT: 21pt; mso-yfti-irow: 1; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 55.25pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=74><o> </o>
Thank you !!!!!!<o></o>
</TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 43.1pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=57></TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 54.45pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=73></TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 47.3pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=63></TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 29.6pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=39></TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 52.9pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=71></TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 39.45pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=53></TD><TD style="BORDER-RIGHT: #ece9d8; PADDING-RIGHT: 5.4pt; BORDER-TOP: #ece9d8; PADDING-LEFT: 5.4pt; PADDING-BOTTOM: 0in; BORDER-LEFT: #ece9d8; WIDTH: 41.95pt; PADDING-TOP: 0in; BORDER-BOTTOM: #ece9d8; HEIGHT: 21pt; BACKGROUND-COLOR: transparent" vAlign=top width=56></TD></TR></TBODY></TABLE>

 

[Kazdima]

bump-))

 

[Kazdima]

Please help!

 

[bertie]

The first problem is that each "description" in column F has multiple deliminators. So the first thing I did was to write a function to standardise these by replacing them with a comma.

   aDelim = Array(" ", "-", "#", ".") [COLOR=green]' add more deliminators if necessary[/COLOR]
 
   [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](aDelim) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](aDelim)
      txt = Replace(txt, aDelim(i), ",")
   [COLOR=darkblue]Next[/COLOR] i

Then you need three nested loops. So, based on the sample code:

   [COLOR=green]'loop through column J (Names)[/COLOR]
      [COLOR=green]'isolate the last name[/COLOR]
 
      [COLOR=green]'loop through column F (Descriptions)[/COLOR]
         [COLOR=green]'send to function to standardise deliminators[/COLOR]
         [COLOR=green]'split the description into an array[/COLOR]
 
         [COLOR=green]'loop through the array[/COLOR]
            [COLOR=green]'compare LastName = Array element[/COLOR]
            [COLOR=green]'if match populate column G[/COLOR]

The full code is shown below.
Create a copy of your worksheet.
Copy and paste the code below into the ThisWorkbook module and test.

The code is based on the sample data provided. I have highlighted where you may need to edit.

[COLOR=darkblue]Sub[/COLOR] ExtractNames()
   [COLOR=darkblue]Dim[/COLOR] colF [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] colJ [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] iPos [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] aRecord [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] sRecord [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] ws [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] sLastName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] tmp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
 
   [COLOR=darkblue]Set[/COLOR] ws = [COLOR=red]Sheets("Sheet1")[/COLOR]
 
   [COLOR=green]'loop through names in column J[/COLOR]
   [COLOR=darkblue]For[/COLOR] [COLOR=red]colJ [/COLOR]= [COLOR=red]5 To 14[/COLOR]
 
      tmp = ws.Range[COLOR=red]("J"[/COLOR] & colJ).Value
      [COLOR=darkblue]If[/COLOR] tmp <> "" [COLOR=darkblue]Then[/COLOR]
         [COLOR=green]'isolate the last name[/COLOR]
         iPos = InStr(1, tmp, " ", vbTextCompare)
         sLastName = Trim(Right(tmp, Len(tmp) - iPos + 1))
 
         [COLOR=green]'loop through records in column F[/COLOR]
         [COLOR=darkblue]For[/COLOR] [COLOR=red]colF = 1 To 4[/COLOR]
            [COLOR=green]'replace multiple deliminators with a comma[/COLOR]
            [COLOR=green]'and split the string into an array[/COLOR]
            sRecord = ws.Range[COLOR=red]("F"[/COLOR] & colF).Value
            sRecord = ReplaceDeliminators(sRecord)
            aRecord = Split(sRecord, ",")
 
            [COLOR=green]'loop through the array[/COLOR]
            [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](aRecord) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](aRecord)
               [COLOR=green]'compare with array element[/COLOR]
               [COLOR=darkblue]If[/COLOR] sLastName = aRecord(i) [COLOR=darkblue]Then[/COLOR]
                  ws.Range("[COLOR=red]G" [/COLOR]& colF).Value = ws.Range[COLOR=red]("J"[/COLOR] & colJ).Value
                  [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
               [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]Next[/COLOR] i
         [COLOR=darkblue]Next[/COLOR] colF
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=darkblue]Next[/COLOR] colJ
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
[COLOR=darkblue]Function[/COLOR] ReplaceDeliminators([COLOR=darkblue]ByRef[/COLOR] txt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]) [COLOR=darkblue]As[/COLOR] String
   [COLOR=green]'======================================================[/COLOR]
   [COLOR=green]'Replace multiple deliminators in a string with a comma[/COLOR]
   [COLOR=green]'======================================================[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] aDelim [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
 
   aDelim = Array([COLOR=red]" ", "-", "#", ".")[/COLOR] [COLOR=green]' add more deliminators if necessary[/COLOR]
 
   [COLOR=darkblue]For[/COLOR] i = [COLOR=darkblue]LBound[/COLOR](aDelim) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](aDelim)
      txt = Replace(txt, aDelim(i), ",")
   [COLOR=darkblue]Next[/COLOR] i
 
   ReplaceDeliminators = txt
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]

 

[Kazdima]

Hello Bertie,

Thank you very much for your help. Unfortunately, I am a beginner in Macros and do not know how to edit your macro...I copied it into my workbook, but it gives me an error "Subscript out of range"...

Can you help me to make it working?

Thank you.

Dan

 

[bertie]

Set ws = Sheets("Sheet1")

Edit this line and replace Sheet1 with the name of your worksheet.

Edit: Please indicate what line the error occurred.

 

[Kazdima]

Hello Bertie,

Thank you for your answer.

Can I send to you privately(on your e-mail) my data report that you could see yourself? My e-mail is kazdima@yahoo.ca

Thank you,

Dan