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>

Product	Cost
A	1
E	5

<tbody>
</tbody>

<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:

Name	Product	Cost
Adam	A	1
Billy	B	2
Tony	C	3
Billy	D	4
Adam	E	5
Tony	F	6
Billy	G	7
Jill	H	8
Frank	I	9
Jill	J	10
Frank	K	11
Billy	L	12
Billy	M	13

<tbody>
</tbody>

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