# Master Data Stacker from Three sheets to One with averages • ### 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 Thursday, January 26, 2017 2:53 PM
Saturday, January 21, 2017 11:22 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 Wednesday, January 25, 2017 10:44 AM
• Marked as answer by 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 Monday, January 23, 2017 11:19 AM
Monday, January 23, 2017 9:39 AM
• Hi Jan,

```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 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 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 Wednesday, January 25, 2017 10:44 AM
• Marked as answer by Thursday, January 26, 2017 4:35 AM
Wednesday, January 25, 2017 9:18 AM
• • 