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:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Fruit[/TD]
[TD]Color (ID)[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Apple[/TD]
[TD]Green[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Apple[/TD]
[TD]Red[/TD]
[/TR]
</tbody>[/TABLE]

User then Clicks Button

Hidden Table Already Filled Out in Another Sheet:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Fruit[/TD]
[TD]Ingredient[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Apple[/TD]
[TD]Flour[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Apple[/TD]
[TD]Sugar
[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Apple[/TD]
[TD]Cinnamon[/TD]
[/TR]
</tbody>[/TABLE]

Output from Macro in Newly Created Sheet:
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Item #
[/TD]
[TD]Fruit[/TD]
[TD]Color[/TD]
[TD]Ingredient [/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]Apple[/TD]
[TD]Green[/TD]
[TD]Flour[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]2[/TD]
[TD]Apple[/TD]
[TD]Green[/TD]
[TD]Sugar[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]3[/TD]
[TD]Apple[/TD]
[TD]Green[/TD]
[TD]Cinnamon[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]4[/TD]
[TD]Apple[/TD]
[TD]Red[/TD]
[TD]Flour[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]5[/TD]
[TD]Apple[/TD]
[TD]Red[/TD]
[TD]Sugar[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]6[/TD]
[TD]Apple[/TD]
[TD]Red[/TD]
[TD]Cinnamon[/TD]
[/TR]
</tbody>[/TABLE]

 

[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