VBA vlookup to Reference Sheet & Copy row data from Master Sheet to Specific sheets

[unknownymous]

Hi Guys,

Can you possibly help me out on the macro I'm trying to sort out? Basically, I have this excel file named "MasterList" with two tabs sheets namely: Master & Reference.
The master contains a list of data while reference sheet has list of countries and its equivalent country group.

Example in "Reference" Sheet:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Country[/TD]
[TD]Group[/TD]
[/TR]
[TR]
[TD]United States[/TD]
[TD]North America[/TD]
[/TR]
[TR]
[TD]Canada[/TD]
[TD]North America[/TD]
[/TR]
[TR]
[TD]Germany[/TD]
[TD]Germany[/TD]
[/TR]
[TR]
[TD]Norway[/TD]
[TD]Rest of Europe[/TD]
[/TR]
[TR]
[TD]Libya[/TD]
[TD]Rest of World[/TD]
[/TR]
</tbody>[/TABLE]


In the "Master" sheet, there's a country column which starts in cell W4 until the last blank cell (W***).

What the macro does:
*In Master Sheet - Look up the "Country" against the "Reference" and get its country "Group"
*For the Above example, 4 sheets will be created (North America, Germany, Rest ow World & Rest of Europe). All data rows that falls under each category will be copied to its designated tabs.


Any help will be much appreciated (I'm still learning about VBA) Thanks in advance!

 

[Fluff]

How about

Sub CopySplitData()
   Dim Cl As Range
   Dim ary As Variant
   Dim Mws As Worksheet
   Dim Rws As Worksheet
   Dim Ky As Variant
   
   Set Mws = Sheets("Master")
   Set Rws = Sheets("Reference")
   With CreateObject("scripting.dictionary")
      For Each Cl In Rws.Range("A2", Rws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 1).Value
         Else
            .Item(Cl.Value) = .Item(Cl.Value) & "|" & Cl.Offset(, 1).Value
         End If
      Next Cl
      If Mws.AutoFilterMode Then Mws.AutoFilterMode = False
      For Each Ky In .keys
         Mws.Range("A4:W4").AutoFilter 23, Split(.Item(Ky), "|"), xlFilterValues
         Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
         Mws.AutoFilter.Range.Copy ActiveSheet.Range("A1")
      Next Ky
      Mws.AutoFilterMode = False
   End With
End Sub

 

[unknownymous]

Thanks Fluff for the quick response. However, the sheets created by the macro are not based in "Group Country" (North America, Germany, Rest of World and etc). I was thinking in the "Master" Sheet, we can add 1 more column where it will look up the value of Country against the "Reference" and get its equivalent " Country Group" first. One thing, can you help me on the code wherein it will copy the format of "Master" sheet to every sheet that will be created while copying the header as well (column header in "Master sheet" is located in cell "A2". Many thanks in advance!

 

[Fluff]

Oops, got it the wrong way round try

Sub CopySplitData()
   Dim Cl As Range
   Dim Ary As Variant
   Dim Mws As Worksheet
   Dim Rws As Worksheet
   Dim Ky As Variant
   
   Set Mws = Sheets("Master")
   Set Rws = Sheets("Sheet1")
   With CreateObject("scripting.dictionary")
      For Each Cl In Rws.Range("B2", Rws.Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, -1).Value
         Else
            .Item(Cl.Value) = .Item(Cl.Value) & "|" & Cl.Offset(, -1).Value
         End If
      Next Cl
      If Mws.AutoFilterMode Then Mws.AutoFilterMode = False
      For Each Ky In .keys
         Mws.Range("A2:W2").AutoFilter 23, Split(.Item(Ky), "|"), xlFilterValues
         Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
         Mws.AutoFilter.Range.Copy ActiveSheet.Range("A1")
      Next Ky
      Mws.AutoFilterMode = False
   End With
End Sub

 

[unknownymous]

Your code works well, thanks Fluff! Just one more thing..how about the header for each sheet? I want to paste it in the 2nd row (A2-W2) and the country breakdown will start in the 4th row (A4-W4).

 

[Fluff]

Try

For Each Ky In .keys
         Mws.Range("A[COLOR=#ff0000]4[/COLOR]:W[COLOR=#ff0000]4[/COLOR]").AutoFilter 23, Split(.Item(Ky), "|"), xlFilterValues
         Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
         Mws.AutoFilter.Range.Copy ActiveSheet.Range("A[COLOR=#ff0000]2[/COLOR]")
      Next Ky

 

[unknownymous]

Yey! Thanks Fluff

 

[Fluff]

Glad to help & thanks for the feedback

 

[unknownymous]

Hi Fluff! Me again. I am having a problem on the format of the created tabs. Can we possibly just:
1. Create a copy of the Master Sheet
2. Rename it based on country region
3. Those country which don't belong on that region will be deleted on each sheet (based on reference sheet)

Thanks so much again in advance.