Macro to Create Table

S

Slazar

New Member
Joined
Aug 28, 2015
Messages
17
Hi all,

Please help!
I need a macro that does the following:

User will input the information in the table below.

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.

Example:

Apple is a Fruit. For Apples, there are two cooking methods (Bake and Fry) with associated pictures 1 and 2 (which are links to another sheet displaying the photo). Part of the outputted table will display all cooking methods, with all associate pictures, for all apples inputted from the user. So it shows the cooking methods for Green Apple and for Red Apple. The outputted table will have empty columns for comments and updates.


Input from User:

[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]Category[/TD]
[TD="align: center"]Type[/TD]
[TD="align: center"]Color (ID)[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Red[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Green[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Green[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Purple[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]Meat[/TD]
[TD="align: center"]Chicken[/TD]
[TD="align: center"]White[/TD]
[/TR]
</tbody>[/TABLE]




User then Clicks Button

Hidden Table Already Filled Out in Another Sheet:
[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]Category[/TD]
[TD="align: center"]Type[/TD]
[TD="align: center"]Cooking Method[/TD]
[TD="align: center"]Picture[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Fry[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Steam[/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Microwave[/TD]
[TD="align: center"]5[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"]Meat[/TD]
[TD="align: center"]Chicken[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"]6[/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: center"]Meat[/TD]
[TD="align: center"]Chicken[/TD]
[TD="align: center"]Grill[/TD]
[TD="align: center"]7[/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: center"]Meat[/TD]
[TD="align: center"]Chicken[/TD]
[TD="align: center"]Fry[/TD]
[TD="align: center"]8[/TD]
[/TR]
</tbody>[/TABLE]




Output from Macro in Newly Created Sheet:
[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]Item #[/TD]
[TD="align: center"]Category[/TD]
[TD="align: center"]Type[/TD]
[TD="align: center"]Color (ID)[/TD]
[TD="align: center"]Cooking Method[/TD]
[TD="align: center"]Updates[/TD]
[TD="align: center"]Comments[/TD]
[TD="align: center"]Picture[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Red[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Red[/TD]
[TD="align: center"]Fry[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]3[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Green[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]Fruit[/TD]
[TD="align: center"]Apple[/TD]
[TD="align: center"]Green[/TD]
[TD="align: center"]Fry[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]5[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Green[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"]6[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Green[/TD]
[TD="align: center"]Steam[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: center"]7[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Green[/TD]
[TD="align: center"]Microwave[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]5[/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: center"]8[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Purple[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: center"]9[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Purple[/TD]
[TD="align: center"]Steam[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]11[/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]Vegetable[/TD]
[TD="align: center"]Broccoli[/TD]
[TD="align: center"]Purple[/TD]
[TD="align: center"]Microwave[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]5[/TD]
[/TR]
[TR]
[TD="align: center"]12[/TD]
[TD="align: center"]11[/TD]
[TD="align: center"]Meat[/TD]
[TD="align: center"]Chicken[/TD]
[TD="align: center"]White[/TD]
[TD="align: center"]Bake[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]6[/TD]
[/TR]
[TR]
[TD="align: center"]13[/TD]
[TD="align: center"]12[/TD]
[TD="align: center"]Meat[/TD]
[TD="align: center"]Chicken[/TD]
[TD="align: center"]White[/TD]
[TD="align: center"]Grill[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]7[/TD]
[/TR]
[TR]
[TD="align: center"]14[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]Meat[/TD]
[TD="align: center"]Chicken[/TD]
[TD="align: center"]White[/TD]
[TD="align: center"]Fry[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]8[/TD]
[/TR]
</tbody>[/TABLE]

 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Here you go tested and works

Sheet1 = user input
Sheet2 = hidden table

Code: 
Sub CreateTable()
Dim r, q As Range
Dim lastRow1, lastRow2, lastRow3, currentRow As Integer
Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "Table"
Sheets("Sheet1").Select
currentRow = 2
lastRow1 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
lastRow2 = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
For Each r In Range("B2:B" & lastRow1)
    For Each q In Sheets("Sheet2").Range("B2:B" & lastRow2)
        If r.Value = q.Value Then
            Sheets("Table").Range("B" & currentRow).Value = q.Offset(, -1).Value
            Sheets("Table").Range("C" & currentRow).Value = q.Value
            Sheets("Table").Range("D" & currentRow).Value = r.Offset(, 1).Value
            Sheets("Table").Range("E" & currentRow).Value = q.Offset(, 1).Value
            Sheets("Table").Range("H" & currentRow).Value = q.Offset(, 2).Value
            currentRow = currentRow + 1
        End If
    Next q
Next r
Sheets("Table").Range("A1").Value = "Item #"
Sheets("Table").Range("B1").Value = "Category"
Sheets("Table").Range("C1").Value = "Type"
Sheets("Table").Range("D1").Value = "Color (ID)"
Sheets("Table").Range("E1").Value = "Cooking Method"
Sheets("Table").Range("F1").Value = "Updates"
Sheets("Table").Range("G1").Value = "Comments"
Sheets("Table").Range("H1").Value = "Picture"
lastRow3 = Sheets("Table").Cells(Sheets("Sheet2").Rows.Count, "B").End(xlUp).Row
    Sheets("Table").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A" & lastRow3), Type:=xlFillSeries
    Range("A1:H" & lastRow3).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Sheets("Table").Range("A1:H1").Select
    Selection.Font.Bold = True
End Sub
 
Upvote 0
Try this:-
User Input:- Sheet1
Hidden Table:- Sheet2

Code: 
[COLOR=navy]Sub[/COLOR] MG13Aug26
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] txt [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] ray(), c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] P [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]With[/COLOR] Sheets("Sheet2")
    [COLOR=navy]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]

With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]
For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    txt = Dn.Value & Dn.Offset(, 1).Value
    [COLOR=navy]If[/COLOR] Not .exists(txt) [COLOR=navy]Then[/COLOR] .Add txt, Array(New Collection, New Collection)
     .Item(txt)(0).Add Dn.Offset(, 2)
    .Item(txt)(1).Add Dn.Offset(, 3)
[COLOR=navy]Next[/COLOR]
[COLOR=navy]
With[/COLOR] Sheets("Sheet1")
    [COLOR=navy]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With

ReDim Preserve ray(1 To 8, 1 To 1)
ray(1, 1) = "Item #": ray(2, 1) = "Category": ray(3, 1) = "Type": ray(4, 1) = "Color (ID)"
ray(5, 1) = "Cooking Method": ray(6, 1) = "Updates": ray(7, 1) = "Comments": ray(8, 1) = "Picture"
c = 1
[COLOR=navy]

For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    txt = Dn.Value & Dn.Offset(, 1).Value
        [COLOR=navy]If[/COLOR] .exists(txt) [COLOR=navy]Then[/COLOR]
          [COLOR=navy]For[/COLOR] n = 1 To .Item(txt)(0).Count
             c = c + 1
             ReDim Preserve ray(1 To 8, 1 To c)
              ray(1, c) = c - 1
              ray(2, c) = Dn.Value
              ray(3, c) = Dn.Offset(, 1).Value
              ray(4, c) = Dn.Offset(, 2).Value
              ray(5, c) = .Item(txt)(0)(n)
              ray(8, c) = .Item(txt)(1)(n)
          [COLOR=navy]Next[/COLOR] n
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] With
[COLOR=navy]

Dim[/COLOR] sht [COLOR=navy]As[/COLOR] Worksheet
Sheets.Add after:=Sheets(Sheets.Count)
[COLOR=navy]Set[/COLOR] sht = ActiveSheet
 [COLOR=navy]With[/COLOR] sht.Range("A1").Resize(c, 8)
      .Value = Application.Transpose(ray)
      .Borders.Weight = 2
      .HorizontalAlignment = xlCenter
      .Columns.AutoFit
  [COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Great! They both work!

Only issue is the link to the picture is gone after running the macro. In the newly created table, it just shows the number in text but is not a clickable link like it is in the hidden table. How do I fix this?
 
Upvote 0
Any ideas on how to preserve hyperlink after running the macro? The link is to another place in the Excel spreadsheet that shows a picture and the text displayed for the link are just numbers.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Match with multiple columns
2
Replies
14
Views
767
Peter_SSs
Peter_SSs
L
  • Question Question
Creating macro for nested calculations within calculations
Replies
2
Views
158
LizN
L
JenniferMurphy
  • Solved
How to compare 2 columns in one table with 2 columns in another table?
Replies
5
Views
361
JenniferMurphy
JenniferMurphy
E
  • Solved
Cut paste anything that is not bold
Replies
3
Views
371
bebo021999
B
M
  • Question Question
Need a formula
Replies
1
Views
236
Md Zahirul Islam
M

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top