How to show a table on another page?

Vba macro table

• QUESTION: Hope you can help me with this. I have 4 sheets within a workbook. Sheets 1 - 3 consist of data as follow: A: Mold No, B: Name, C: Creation Date, D: No. of mold set, E,F,G... and so on: Entry/Exit date of molds A B C D E F G P101 Mold-A Jan1/10 3 Ex-Jan10/10 En-Feb2/10 Ex-Mar1/10 P102 Mold-B Jan2/10 2 Ex-Feb1/10 En-Feb20/10 . . . Each mold will have entry and Exit dates that will be entered in column H,I and so on continually but on the same row. Sheet 2 and 3 will have similar layout, but with different mold numbers. In sheet 4 will have a table where if I input the mold number in cell B1, it will search for that specific mold number in all the sheets and generate a table as exampled below: Ex:B1=P101 A2 B2 C2 D2 Mold-A Jan1/10 3 Ex-Jan10/10 En-Feb2/10 Ex-Mar1/10 I have used function statements previously to generate this table, but as I add more sheets into the workbook and more mold numbers into each sheets. My little table becomes a massive page of laggy function statements where I have to keep modifying in accordance to the more Entry/Exit dates I add. I hope by using macro, it will make things easier, hope you can help me out with this. Hope the attached image will help clarify, many ANSWER: dave, Yes a macro could search your sheets and put in the data as you show make a copy of your workbook and take the formulas out of row 3 and below on sheet4. Then select your mold in A1 of sheet4 and run this macro Sub BuildTable() Dim sh As Worksheet, sh4 As Worksheet Dim r As Range, r1 As Range, r2 As Range, r4 As Range Dim cell4 As Range, cnt As Long, res As Variant Dim rw As Long Set sh4 = Worksheets("Sheet4") Set r = sh4.Range("A1") If IsEmpty(r) Then Exit Sub For Each sh In Worksheets If sh.Name <> sh4.Name Then Set r1 = sh.Range(sh.Cells(2, 1), sh.Cells(sh.Rows.Count, 1).End(xlUp)) cnt = Application.CountIf(r1, r.Value) If cnt = 1 Then res = Application.Match(r.Value, r1, 0) Set r2 = r1(res) sh4.Range("A3:D12").ClearContents sh4.Range("A3").Value = r2.Offset(0, 1) sh4.Range("B3").Value = r2.Offset(0, 2) sh4.Range("B3").NumberFormat = "mm/dd/yyyy" sh4.Range("C3").Value = r2.Offset(0, 3) If Not IsEmpty(r2.Offset(0, 4)) Then rw = 3 Set r4 = sh.Range(sh.Cells(r2.Row, 4), _ sh.Cells(r2.Row, sh.Columns.Count).End(xlToLeft)) For Each cell4 In r4 If Not IsEmpty(cell4) Then sh4.Cells(rw, 4).Value = cell4.Value rw = rw + 1 End If Next End If End If End If Next End Sub the macro should be placed in a general module (Insert=>Module in the Visual Basic Editor Menu) I assume you know how about macros and how to write and use them. If you need more detailed assistance, post back with a followup. the macro was tested with a simplified recreation of what you show in your image and it worked for me. ---------- FOLLOW-UP ---------- QUESTION: ANSWER: Dave, Possibly this modification will do it. Sub BuildTable1() Dim sh As Worksheet, sh4 As Worksheet Dim r As Range, r1 As Range, r2 As Range, r4 As Range Dim cell4 As Range, cnt As Long, res As Variant Dim rw As Long, cell as Range Set sh4 = Worksheets("Sheet4") Set r = sh4.Range("A1") rw = 3 If IsEmpty(r) Then Exit Sub For Each sh In Worksheets If sh.Name <> sh4.Name Then Set r1 = sh.Range(sh.Cells(2, 1), sh.Cells(sh.Rows.Count, 1).End(xlUp)) for each cell in r1 if cell = r.value then set r2 = cell sh4.Range("A3:D12").ClearContents sh4.Range("A3").Value = r2.Offset(0, 1) sh4.Range("B3").Value = r2.Offset(0, 2) sh4.Range("B3").NumberFormat = "mm/dd/yyyy" sh4.Range("C3").Value = r2.Offset(0, 3) If Not IsEmpty(r2.Offset(0, 4)) Then Set r4 = sh.Range(sh.Cells(r2.Row, 4), _ sh.Cells(r2.Row, sh.Columns.Count).End(xlToLeft)) For Each cell4 In r4 If Not IsEmpty(cell4) Then sh4.Cells(rw, 4).Value = cell4.Value rw = rw + 1 End If Next End If End If End If Next End Sub ---------- FOLLOW-UP ---------- QUESTION: Dear Sorry to bother you again. For the second sets of code, when I run it, I keep getting the error code "End If without Block If", but I couldn't figure out how to fix it. Also, I am using this code which allows repetition for another data workbook, but I will only have all my data on "Sheet1" and my search on "Sheet4", which portion of the code should I delete?

• Answer:

  Here is the revised code, but I don't really understand exactly what you mean by repetitive so this is just a guess at what you want. >if the mold numbers are repetitive, if is possible to display all repetitive molds and their according details also? > I am using this code which allows repetition for another data workbook I just don't understand what your situation is. And since I don't, it would only be luck if this code does what you want. Sub BuildTable1() Dim sh As Worksheet, sh4 As Worksheet Dim r As Range, r1 As Range, r2 As Range, r4 As Range Dim cell4 As Range, cnt As Long, res As Variant Dim rw As Long, cell As Range Set sh4 = Worksheets("Sheet4") Set r = sh4.Range("A1") rw = 3 If IsEmpty(r) Then Exit Sub sh = Worksheets("Sheet1") Set r1 = sh.Range(sh.Cells(2, 1), sh.Cells(sh.Rows.Count, 1).End(xlUp)) For Each cell In r1 If cell = r.Value Then Set r2 = cell sh4.Range("A3:D12").ClearContents sh4.Range("A3").Value = r2.Offset(0, 1) sh4.Range("B3").Value = r2.Offset(0, 2) sh4.Range("B3").NumberFormat = "mm/dd/yyyy" sh4.Range("C3").Value = r2.Offset(0, 3) If Not IsEmpty(r2.Offset(0, 4)) Then Set r4 = sh.Range(sh.Cells(r2.Row, 4), _ sh.Cells(r2.Row, sh.Columns.Count).End(xlToLeft)) For Each cell4 In r4 If Not IsEmpty(cell4) Then sh4.Cells(rw, 4).Value = cell4.Value rw = rw + 1 End If Next End If End If Next End Sub Sorry, but I can't write code to a situation I don't understand.