Excel VBA to Create and Autofill New Table

[Slazar]

Hi all,

I'm mediocre at best with VBA so need quite a lot of help and may be asking questions to understand better.
I need a macro that does the following:

User will input the information in the table below. User will input a category (Fruit) and an identifying label (Color).
User will then click a button tied to the macro. The macro will return the filled out table in a newly created sheet.
For the table created by the macro, the cells will need to have all borders filled.

Information on the outputted table will be based on another table (containing ingredients) in another sheet.


Input from User:

	A	B
1	Fruit	Color (ID)
2	Apple	Green
3	Apple	Red

<tbody>
</tbody>

User then Clicks Button

Hidden Table Already Filled Out in Another Sheet:

	A	B
1	Fruit	Ingredient
2	Apple	Flour
3	Apple	Sugar
4	Apple	Cinnamon

<tbody>
</tbody>

Output from Macro in Newly Created Sheet:

	A	B	C	D
1	Item #	Fruit	Color	Ingredient
2	1	Apple	Green	Flour
3	2	Apple	Green	Sugar
4	3	Apple	Green	Cinnamon
5	4	Apple	Red	Flour
6	5	Apple	Red	Sugar
7	6	Apple	Red	Cinnamon

<tbody>
</tbody>

 

[MickG]

"User" Table on sheet1
"Hidden Table" on sheet2
Results on Sheet.

[COLOR="Navy"]Sub[/COLOR] MG25Jul49
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dn1 [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range, Dn2 [COLOR="Navy"]As[/COLOR] Range
c = 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
ReDim ray(1 To Rng1.Count * Rng2.Count + 1, 1 To 4)
ray(1, 1) = "Item #": ray(1, 2) = "Fruit": ray(1, 3) = "Color": ray(1, 4) = "Ingredient"

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn1 [COLOR="Navy"]In[/COLOR] Rng1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn2 [COLOR="Navy"]In[/COLOR] Rng2
            [COLOR="Navy"]If[/COLOR] Dn2.Value = Dn1.Value [COLOR="Navy"]Then[/COLOR]
              c = c + 1
           ray(c, 1) = c - 1: ray(c, 2) = Dn1.Value: ray(c, 3) = Dn1.Offset(, 1).Value
            ray(c, 4) = Dn2.Offset(, 1).Value
               
            [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]Next[/COLOR] Dn2
[COLOR="Navy"]Next[/COLOR] Dn1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3").Range("A1").Resize(c, 4)
    .Value = ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick