VBA for VLOOKUP

[nik0101]

Hi,

I'm new to VBA and wanted some help drafting out a code that would help me automate the following process:

1. Create different sheets based off of names on a master sheet (eg: below)
2. List corresponding product names to a particular name in the respective sheets (for instance: Adam would have products A and E, and Billy would have B,D,G,L,M as per the table below)
3. List corresponding costs for each product.

So sheet Adam should have:
<style><!--table {mso-displayed-decimal-separator:"\."; mso-displayed-thousand-separator:"\,";}@page {margin:.75in .7in .75in .7in; mso-header-margin:.3in; mso-footer-margin:.3in;}tr {mso-height-source:auto;}col {mso-width-source:auto;}br {mso-data-placement:same-cell;}td {padding-top:1px; padding-right:1px; padding-left:1px; mso-ignoreadding; color:black; font-size:12.0pt; font-weight:400; font-style:normal; text-decoration:none; font-family:Calibri, sans-serif; mso-font-charset:0; mso-number-format:General; text-align:general; vertical-align:bottom; border:none; mso-background-source:auto; mso-pattern:auto; mso-protection:locked visible; white-space:nowrap; mso-rotate:0;}--></style>[TABLE="width: 174"]
<tbody>[TR]
[TD="width: 87"]Product[/TD]
[TD="width: 87"]Cost[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]E[/TD]
[TD="align: right"]5[/TD]
[/TR]
</tbody>[/TABLE]

<style><!--table {mso-displayed-decimal-separator:"\."; mso-displayed-thousand-separator:"\,";}@page {margin:.75in .7in .75in .7in; mso-header-margin:.3in; mso-footer-margin:.3in;}tr {mso-height-source:auto;}col {mso-width-source:auto;}br {mso-data-placement:same-cell;}td {padding-top:1px; padding-right:1px; padding-left:1px; mso-ignoreadding; color:black; font-size:12.0pt; font-weight:400; font-style:normal; text-decoration:none; font-family:Calibri, sans-serif; mso-font-charset:0; mso-number-format:General; text-align:general; vertical-align:bottom; border:none; mso-background-source:auto; mso-pattern:auto; mso-protection:locked visible; white-space:nowrap; mso-rotate:0;}--></style>

Sample Table:
[TABLE="width: 261"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Product[/TD]
[TD]Cost[/TD]
[/TR]
[TR]
[TD]Adam[/TD]
[TD]A[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]Billy[/TD]
[TD]B[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]Tony[/TD]
[TD]C[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]Billy[/TD]
[TD]D[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Adam[/TD]
[TD]E[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD]Tony[/TD]
[TD]F[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD]Billy[/TD]
[TD]G[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD]Jill[/TD]
[TD]H[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD]Frank[/TD]
[TD]I[/TD]
[TD="align: right"]9[/TD]
[/TR]
[TR]
[TD]Jill[/TD]
[TD]J[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Frank[/TD]
[TD]K[/TD]
[TD="align: right"]11[/TD]
[/TR]
[TR]
[TD]Billy[/TD]
[TD]L[/TD]
[TD="align: right"]12[/TD]
[/TR]
[TR]
[TD]Billy[/TD]
[TD]M[/TD]
[TD="align: right"]13[/TD]
[/TR]
</tbody>[/TABLE]

Any guidance/help would be really helpful.

Thanks.

 

[JoeMo]

Try this. Assumes your table of names is on Sheet1 with the "Name" header in A1.

Set Sht1 = Sheets("Sheet1")
Set R = Sht1.Range("A1").CurrentRegion
Application.ScreenUpdating = False
With Sht1
    .Columns("E").ClearContents
    R.Columns(1).AdvancedFilter Action:=xlFilterCopy, copytorange:=Sht1.Range("E1"), unique:=True
    For Each Nam In .Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row)
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(Nam.Value).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Nam.Value
        With R
            .AutoFilter field:=1, Criteria1:=Nam.Value
            On Error Resume Next
            .Columns(2).Resize(, 2).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(Nam.Value).Range("A1")
            On Error GoTo 0
        End With
        R.AutoFilter
    Next Nam
    .Columns("E").ClearContents
End With
Sht1.Select
Application.ScreenUpdating = True
End Sub