none
Master Data Stacker from Three sheets to One with averages RRS feed

  • Question

  • Hello,

    I'm working on a macro to sift through each excel sheet, find the same batch number., and paste it into a test sheet for analysis in a specified order (see below). Then each of the batch numbers on three sheets (F (Blue), P(Yellow/Tan), house (Green) Data) will need to be pasted into a fourth sheet (Zach's Test Sheet) in a horizontal fashion. Where the average of specific values will be calculated. I used the above color code to help you identify where the information comes from. Please see link for example worksheet. There are two iterations of the calculation demonstrated. I would like the rest of the analysis to continue in a vertical fashion for all batch numbers. 

    My current code adds a column in each Y, P, and house sheet. Then it places an n in Col. A when a new batch occurs. Now that I have identifying points for each batch. I need to

    1. Copy and paste each batch data from the F tab, P tab, and house tab into a horizontal row in Zach's Test Sheet starting in column B. 

    2. Average each of the columns for the batch (as seen in the spreadsheet for specific columns) otherwise if you want to be lazy you can just do averages for the entire row of that batch)

    3. Place the batch number of the averaged columns in column A with respect to the averaging row.


    Here is my current code. I'm pretty new at this, and my hope is to continue to learn. I hope I didn't bit too much off this time. Thanks for all of your help guys!

    Sub HouseCalc()
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    
    'Define dimensions
        
       ' i = Range("A2", "A1000000").Select 'This selects FVB numbers
        
    Worksheets("House Data").Activate
    'Insert Column to the left of Column A in House Data
        Columns("A:A").Insert Shift:=xlToRight, _
          CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
          
    'Worksheets("F Data").Activate
    'Insert Column to the left of Column A in F Data
    '    Columns("A:A").Insert Shift:=xlToRight, _
    '      CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
          
    ' Worksheets("P Data").Activate
    'Insert Column to the left of Column A in P Data
    '    Columns("A:A").Insert Shift:=xlToRight, _
    '      CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Loop to place "n" in Column A of "House Data"
    
    Worksheets("House Data").Activate
    
    Dim nrow As Long
    
    nrow = 3 'start on the 3rd row
        Do While ActiveSheet.Cells(nrow, 2) <> "" 'Counting how many cells are in column 2
    nrow = nrow + 1
    
    Loop
    Dim q As Long
    
    For q = 3 To nrow - 2
    
    'place and "n" on col A. if cells q not equal to q+1
    If ActiveSheet.Cells(q, 2) <> ActiveSheet.Cells(q + 1, 2) Then
        ActiveSheet.Cells(q + 1, 1) = "n"
    End If
    
    Next q
    '''''''''''''''''
    'Loop to place "n" in Column A of "House Data"
    
    'Worksheets("F Data").Activate
    
    'nrow = 3 'start on the 3rd row
    '    Do While ActiveSheet.Cells(nrow, 2) <> "" 'Counting how many cells are in column 2
    'nrow = nrow + 1
    
    'Loop
    
    
    'For q = 3 To nrow - 2
    
    'place and "n" on col A. if cells q not equal to q+1
    'If ActiveSheet.Cells(q, 2) <> ActiveSheet.Cells(q + 1, 2) Then
     '   ActiveSheet.Cells(q + 1, 1) = "n"
    'End If
    
    'Next q
    ''''''''''''''''''''
    'Worksheets("P Data").Activate
    
    'nrow = 3 'start on the 3rd row
    '    Do While ActiveSheet.Cells(nrow, 2) <> "" 'Counting how many cells are in column 2
    'nrow = nrow + 1
    
    'Loop
    
    'For q = 3 To nrow - 2
    
    'place and "n" on col A. if cells q not equal to q+1
    'If ActiveSheet.Cells(q, 2) <> ActiveSheet.Cells(q + 1, 2) Then
    '    ActiveSheet.Cells(q + 1, 1) = "n"
    'End If
    
    'Next q
        
        End With
        
    End Sub

    Zachman



    • Edited by Zachman Do Thursday, January 26, 2017 2:53 PM
    Saturday, January 21, 2017 11:22 PM

Answers

  • Zachman,

    I deleted the column A in House Data that you used for placing the n's to distinguish between the batches.
    So column A in my situation is the column with the batch-numbers.
    You left that column, that's why you didn't get any result.

    Second, the formulas had to be inserted as array-formulas with Ctrl+Shift+Enter.
    On the other hand, this formulas are rather slow.
    So I have used new formulas (not array) and they are much faster.

    One observation: the headers in Filtration Data have changed to formulas, not what you want, I think.

    The new formulas:
    In Jan Test Sheet make the header Row

    From Filtration Data
    Batch Time in minutes

    From House Data  all the headers from T to CWVF

    Formula's
    Batch
    Time in minutes: =IFERROR(SUMIF('Filtration Data'!$A:$A,$A2,'Filtration Data'!I:I)/COUNTIF('Filtration Data'!$A:$A,$A2),"")

    T: =IFERROR(SUMIF('House Data'!$A:$A,$A2,'House Data'!I:I)/COUNTIF('House Data'!$A:$A,$A2),"")
    Fill this formule to the right until the column with CWVF as header.
    If needed, delete the columns SR and VTP.

    Do something similar with PCI Data.

    Copy the header row to row 10

    (so for the formulas and the code I've assumed that column A in House Data (and the other sheets) are the Batch-numbers)

    A new code, without the copy and paste action:

    Sub FindBatches()
        Dim sh As Worksheet
        Dim shD As Worksheet
        Dim shH As Worksheet
        Dim rngB As Range
        Dim rLast As Long
        Dim rInsert As Long
        Dim lngB As Long
        
        lngB = -1
        Set sh = Worksheets("Filtration Data")
        Set shD = Worksheets("Test Sheet")
        Set shH = Worksheets("House Data")
        rLast = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
        For Each rngB In sh.Range("A2:A" & rLast)
            If rngB <> lngB Then
                'only if rngB is in House Data then proceed
                If Not shH.Range("A:A").Find(rngB.Value) Is Nothing Then
                
                    shD.Range("A2") = rngB.Value
                    
                    rInsert = shD.Range("A" & sh.Rows.Count).End(xlUp).Row + 1
                    shD.Range("A" & rInsert & ":AI" & rInsert) = shD.Range("A2:AI2").Value
                End If
            End If
            lngB = rngB.Value
        Next
        shD.Range("A2") = 0
    End Sub
    

    Jan


    • Edited by jgkzdl Wednesday, January 25, 2017 10:44 AM
    • Marked as answer by Zachman Do Thursday, January 26, 2017 4:35 AM
    Wednesday, January 25, 2017 9:18 AM

All replies

  • Hi Zachman,

    For your issue, it is a much complex requirement, I would suggest you split them into many parts, and then achieve them one by one.

    >> Copy and paste each batch data from the F tab, P tab, and house tab into a horizontal row in Zach's Test Sheet starting in column B.

    Let us discuss this requirement first. I have downloaded your file, but I failed to understand your requirement. I found Batch column in House Data sheet, but I did not find it in F and P sheets, what are the corroding columns in F and P?

    I would suggest you share us a simple file which contains source data, and the expected result for this requirement.

    Best Regards,

    Edward

    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, January 23, 2017 6:36 AM
  • Hello Zachman,

    This a little bit different approach but perhaps it is something you can use.

    Make a new sheet "Test Sheet"

    and put these items in the first row (as headers):

    Batch
    Time in minutes
    (an empty column)
    T
    MIT
    MPH
    H2O
    (delete column later)
    MIV
    G
    LRG
    TLT
    PBG
    PBV
    PBG
    DW
    EBT
    CWT
    (delete column later)
    CS
    CE
    THMC
    TMC
    OV
    TOGF
    CWVF

    Copy the first row to row 10
    Then in row 2 insert the next formulas under the headers:
    Batch
    Time in minutes: =IFERROR(AVERAGE(IF('Filtration Data'!$A:$A=$A2,'Filtration Data'!I:I,"")),"")

    T: =AVERAGE(IF('House Data'!$A:$A=$A2,'House Data'!I:I,""))
    Fill this formule to the right until the column with CWVF as header.

    Now delete the 2 columns with header (delete column later).

    This sheet is ready to get the information via VBA.
    The code to use this sheet is:

    Sub FindBatches()
        Dim sh As Worksheet
        Dim shD As Worksheet
        Dim shH As Worksheet
        Dim rngB As Range
        Dim rLast As Long
        Dim rInsert As Long
        Dim lngB As Long
        Application.ScreenUpdating = False
        
        lngB = -1
        Set sh = Worksheets("Filtration Data")
        Set shD = Worksheets("Test Sheet")
        Set shH = Worksheets("House Data")
        rLast = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
        For Each rngB In sh.Range("A2:A" & rLast)
            If rngB <> lngB Then
                'test if rngB in House Data then
                If Not shH.Range("A:A").Find(rngB.Value) Is Nothing Then
                
                shD.Range("A2") = rngB.Value
                shD.Range("A2").EntireRow.Copy
                
                rInsert = shD.Range("A" & sh.Rows.Count).End(xlUp).Row + 1
                shD.Range("A" & rInsert).PasteSpecial xlPasteValues
                End If
            End If
            lngB = rngB.Value
        Next
        Application.CutCopyMode = False
        shD.Range("A2") = 0
        Application.ScreenUpdating = True
    End Sub

    You will get only the batch-averages in the new sheet (and so only the headers of sheets Filtration Data and House Data are in the Test Sheet)

    Edit: I forgot to say that the inserted formulas are array-formulas so you need to press Ctrl+Shift+Enter to enter them in your worksheet.

    Jan


    • Edited by jgkzdl Monday, January 23, 2017 11:19 AM
    Monday, January 23, 2017 9:39 AM
  • Hi Jan,

    Thanks for the tips! I tried out your code. It some what makes sense to me. I followed your directions and placed the above formulas into the columns. I adjusted the code accordingly to match the Columns headings in the original sheets ( I also added some filtration data on the end to see if it worked for that tab as well. I changed the sheet and column references accordingly). After running the code. I only got one row of numbers for a batch that didn't exist (it was batch #0). Could I have miss placed the circular reference? Please see the linked spreadsheet. Jan your code has been run and the output is show in "Jan Test Sheet"(this is the sheet it should open too. I also changed the code for sub Jan Test Sheet). I have made another sheet "Test Sheet Copy" for easy replacement of formulas. I made it easy to see the different sheet references through outlines (from left to right... Filtration-->House-->PCI data. Thanks for all of your help with this.

    Sub FindBatches()
        Dim sh As Worksheet
        Dim shD As Worksheet
        Dim shH As Worksheet
        Dim rngB As Range
        Dim rLast As Long
        Dim rInsert As Long
        Dim lngB As Long
        Application.ScreenUpdating = False
        
        lngB = -1
        Set sh = Worksheets("Filtration Data")
        Set shD = Worksheets("Jan Test Sheet")
        Set shH = Worksheets("House Data")
        rLast = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
        For Each rngB In sh.Range("A2:A" & rLast)
            If rngB <> lngB Then
                'test if rngB in House Data then
                If Not shH.Range("A:A").Find(rngB.Value) Is Nothing Then
                
                shD.Range("A2") = rngB.Value
                shD.Range("A2").EntireRow.Copy
                
                rInsert = shD.Range("A" & sh.Rows.Count).End(xlUp).Row + 1
                shD.Range("A" & rInsert).PasteSpecial xlPasteValues
                End If
            End If
            lngB = rngB.Value
        Next
        Application.CutCopyMode = False
        shD.Range("A2") = 0
        Application.ScreenUpdating = True
    End Sub


    • Edited by Zachman Do Thursday, January 26, 2017 2:54 PM
    Tuesday, January 24, 2017 1:46 AM
  • Zachman,

    The link seems to go to the same file as the one from your first message, so no 'Jan test sheet'!?

    Jan

    Tuesday, January 24, 2017 8:38 AM
  • Sorry Jan,

    I linked the old sheet. Here is the updated link. (I just verified it this time)


    • Edited by Zachman Do Thursday, January 26, 2017 2:54 PM
    Tuesday, January 24, 2017 10:38 PM
  • Zachman,

    I deleted the column A in House Data that you used for placing the n's to distinguish between the batches.
    So column A in my situation is the column with the batch-numbers.
    You left that column, that's why you didn't get any result.

    Second, the formulas had to be inserted as array-formulas with Ctrl+Shift+Enter.
    On the other hand, this formulas are rather slow.
    So I have used new formulas (not array) and they are much faster.

    One observation: the headers in Filtration Data have changed to formulas, not what you want, I think.

    The new formulas:
    In Jan Test Sheet make the header Row

    From Filtration Data
    Batch Time in minutes

    From House Data  all the headers from T to CWVF

    Formula's
    Batch
    Time in minutes: =IFERROR(SUMIF('Filtration Data'!$A:$A,$A2,'Filtration Data'!I:I)/COUNTIF('Filtration Data'!$A:$A,$A2),"")

    T: =IFERROR(SUMIF('House Data'!$A:$A,$A2,'House Data'!I:I)/COUNTIF('House Data'!$A:$A,$A2),"")
    Fill this formule to the right until the column with CWVF as header.
    If needed, delete the columns SR and VTP.

    Do something similar with PCI Data.

    Copy the header row to row 10

    (so for the formulas and the code I've assumed that column A in House Data (and the other sheets) are the Batch-numbers)

    A new code, without the copy and paste action:

    Sub FindBatches()
        Dim sh As Worksheet
        Dim shD As Worksheet
        Dim shH As Worksheet
        Dim rngB As Range
        Dim rLast As Long
        Dim rInsert As Long
        Dim lngB As Long
        
        lngB = -1
        Set sh = Worksheets("Filtration Data")
        Set shD = Worksheets("Test Sheet")
        Set shH = Worksheets("House Data")
        rLast = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
        For Each rngB In sh.Range("A2:A" & rLast)
            If rngB <> lngB Then
                'only if rngB is in House Data then proceed
                If Not shH.Range("A:A").Find(rngB.Value) Is Nothing Then
                
                    shD.Range("A2") = rngB.Value
                    
                    rInsert = shD.Range("A" & sh.Rows.Count).End(xlUp).Row + 1
                    shD.Range("A" & rInsert & ":AI" & rInsert) = shD.Range("A2:AI2").Value
                End If
            End If
            lngB = rngB.Value
        Next
        shD.Range("A2") = 0
    End Sub
    

    Jan


    • Edited by jgkzdl Wednesday, January 25, 2017 10:44 AM
    • Marked as answer by Zachman Do Thursday, January 26, 2017 4:35 AM
    Wednesday, January 25, 2017 9:18 AM
  • Thanks Jan for all of your help! Is there a book or place you could advise me to reference to learn more about these neat functions?
    Thursday, January 26, 2017 2:55 PM
  • Zachman,

    The books of John Walkenbach are, as far as I know, rather substantial and good.

    But someone may chime in with other ideas/titles/authors.

    Jan

    Thursday, January 26, 2017 8:53 PM