Combine 4 Sheets into 1

[idoon3y]

Hi,

My file has multiple sheets. The goal is to find an exact match in column C of sheet 4 to column M of sheet 1, sheet 2 and sheet 3.

Edit: Code formatting

Image of sheet 1:

https://imgur.com/a/pQQvGHL

Image of sheet 2:

https://imgur.com/a/lhUvRjz

Image of sheet 3:

https://imgur.com/a/YDQD5je

Image of sheet 4:

https://imgur.com/a/soox91q

Image of desired sheet 4 outcome:

https://imgur.com/a/1Ke1MZH

In theory, what I am trying to do is if X = Y, then X = Z.

For example, if we are working with cell C2 in sheet 4, where C2 = 107028. I want to find which row in sheet 1 M contains 107028. When a row from column M of sheet 1 = 107028, I want to take the data from that row in columns D:K of that row and make them the values for columns D:K in sheet 4 in the row that 107028 is on.

This process repeats for sheets 2 and 3. Find exact matches in sheet 2 row M to sheet 4 row C and subsequently sheet 3 row M value to sheet 4 row C.

I have attempted to loop through the sheet of "Print_Stats" (sheet 1 in my post's case), "Email_Stats" (sheet 2 in my post's case), and "Link_Stats" (sheet 3 in my posts case) into "Combined_Stats" (which in our case is sheet 4):

Code:

Sub Combine_Stats ()

'attempted loop

Dim p_id As Integer

Dim l_id As Integer

Dim e_id As Integer

Dim c_id As String

Dim i As Long

'get the number of the last row with data in all four sheets

lastRowcombined = Worksheets("Combined_Stats").Cells(Rows.Count, "C").End(xlUp).Row

lastRowprint = Worksheets("Print_Stats").Cells(Rows.Count, "M").End(xlUp).Row

lastRowemail = Worksheets("Email_Stats").Cells(Rows.Count, "M").End(xlUp).Row

LastRowlink = Worksheets("Link_Stats").Cells(Rows.Count, "M").End(xlUp).Row

'for every value in column M of From Print_Stats trying to find when the p_id = the c_id from column C in Combined_Stats sheet

For i = 1 To lastRowprint

If Worksheets("Print_Stats").Cells(i, "M").Value = Worksheets("Combined_Stats").Cells(i,"C").Value Then

Worksheets("Print_Stats").Range(Cells(i, "M")).Copy

Worksheets("Combined_Stats").Range("C" & lastRowcombined).PasteSpecial xlPasteValues

End If

Next

'for every value in column M of From Email_Stats trying to find when the p_id = the c_id from column C in Combined_Stats sheet. Pasting values to next available column

For i = 1 To lastRowemail

If Worksheets("Email_Stats").Cells(i, "M").Value = Worksheets("Combined_Stats").Cells(i,"C").Value Then

Worksheets("Email_Stats").Range(Cells(i, "M")).Copy

Worksheets("Combined_Stats").Range("C" & lastRowcombined).PasteSpecial xlPasteValues

End If

Next

'for every value in column M of From Link_Stats trying to find when the p_id = the c_id from column C in Combined_Stats sheet. Pasting values to next available column

For i = 1 To LastRowlink

If Worksheets("Link_Stats").Cells(i, "M").Value = Worksheets("Combined_Stats").Cells(i,"C").Value Then

Worksheets("Link_Stats").Range(Cells(i, "M")).Copy

Worksheets("Combined_Stats").Range("C" & lastRowcombined).PasteSpecial xlPasteValues

End If

Next

End Sub

 

[NdNoviceHlp]

Hi idoon3y. You can trial this untested code. Please save a backup copy of your workbook before testing. Good luck. Dave

Sub Combine_Stats()
Dim i As Long, Cnt As Long, Flag As Boolean, lastRowcombined As Long
Dim LastRow As Long, WsCnt As Integer
'get the number of the last row with data in all four sheets
lastRowcombined = Worksheets(4).Cells(Rows.Count, "C").End(xlUp).Row
On Error GoTo erfix
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For WsCnt = 1 To 3
LastRow = Worksheets(WsCnt).Cells(Rows.Count, "M").End(xlUp).Row
Flag = False
For Cnt = 2 To lastRowcombined
For i = 2 To LastRow
If Worksheets(WsCnt).Cells(i, "M").Value = Worksheets(4).Cells(Cnt, "C").Value Then
With Worksheets(WsCnt)
.Range(.Cells(i, "D"), .Cells(i, "K")).Copy
End With
Worksheets(4).Range("C" & Cnt).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Flag = True
Exit For
End If
Next i
If Flag Then
Exit For
End If
Next Cnt
Next WsCnt
erfix:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[idoon3y]

@NdNoviceHlp I appreciate the reply! This partially worked. I have attached a screenshot of what sheet 4 (combined_stats) looks like. It seems the values only got picked from sheet 1 into sheet 4. Also, if it looks like the values were placed into the C column of sheet 4 instead of in column D.

https://imgur.com/a/ujBPMi1

Once again, I truly appreciate your help!

 

[NdNoviceHlp]

Whoops. This line...

Worksheets(4).Range("C" & Cnt).PasteSpecial xlPasteValues

should be...

Worksheets(4).Range("D" & Cnt).PasteSpecial xlPasteValues

Not real sure about the only 1 sheet? Is there more than 1 sheet that has data for the same value in Sheet4. If so where do you want that if it's not pasted on the same row? Dave
ps. can't really see the output

 

[idoon3y]

Whoops. This line...

Worksheets(4).Range("C" & Cnt).PasteSpecial xlPasteValues

should be...

Worksheets(4).Range("D" & Cnt).PasteSpecial xlPasteValues

Not real sure about the only 1 sheet? Is there more than 1 sheet that has data for the same value in Sheet4. If so where do you want that if it's not pasted on the same row? Dave
ps. can't really see the output

That is correct! Both sheets 2 & 3 column M will have data for the same value in sheet 4. If sheet 2's D:K data can be pasted to columns L:S in sheet 4, while sheet 3's D:E data be pasted in sheet 4's T:U columns. Thanks so much!

 

[NdNoviceHlp]

OK. Trial this...

Sub Combine_Stats()
Dim i As Long, Cnt As Long, Flag As Boolean, lastRowcombined As Long
Dim LastRow As Long, WsCnt As Integer
'get the number of the last row with data in all four sheets
lastRowcombined = Worksheets(4).Cells(Rows.Count, "C").End(xlUp).Row
On Error GoTo erfix
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For WsCnt = 1 To 3
LastRow = Worksheets(WsCnt).Cells(Rows.Count, "M").End(xlUp).Row
Flag = False
For Cnt = 2 To lastRowcombined
For i = 2 To LastRow
If Worksheets(WsCnt).Cells(i, "M").Value = Worksheets(4).Cells(Cnt, "C").Value Then
With Worksheets(WsCnt)
.Range(.Cells(i, "D"), .Cells(i, "K")).Copy
End With
If WsCnt = 1 Then
Worksheets(4).Range("D" & Cnt).PasteSpecial xlPasteValues
ElseIf WsCnt = 2 Then
Worksheets(4).Range("L" & Cnt).PasteSpecial xlPasteValues
Else
Worksheets(4).Range("T" & Cnt).PasteSpecial xlPasteValues
End If
Application.CutCopyMode = False
Flag = True
Exit For
End If
Next i
If Flag Then
Exit For
End If
Next Cnt
Next WsCnt
erfix:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Dave

 

[idoon3y]

https://imgur.com/a/70vmEsY

Here is an image of how sheet 4 looked after the macro. It only updated row 2 of sheet 4, but most of the values didn't render and the D:E column in sheet 4 row 2 both have "0", where they should have "1" and "A", respectively. Once again, I appreciate your help.

 

[NdNoviceHlp]

Is this a typo... while sheet 3's D:E data be pasted in sheet 4's T:U columns... Is it D:E or D:K? Dave

 

[NdNoviceHlp]

If that's a typo, I had a logic error. Trial #3...

Sub Combine_Stats()
Dim i As Long, Cnt As Long, Flag As Boolean, lastRowcombined As Long
Dim LastRow As Long, WsCnt As Integer
'get the number of the last row with data in all four sheets
lastRowcombined = Worksheets(4).Cells(Rows.Count, "C").End(xlUp).Row
On Error GoTo erfix
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Cnt = 2 To lastRowcombined
For WsCnt = 1 To 3
LastRow = Worksheets(WsCnt).Cells(Rows.Count, "M").End(xlUp).Row
Flag = False
For i = 2 To LastRow
If Worksheets(WsCnt).Cells(i, "M").Value = Worksheets(4).Cells(Cnt, "C").Value Then
With Worksheets(WsCnt)
.Range(.Cells(i, "D"), .Cells(i, "K")).Copy
End With
If WsCnt = 1 Then
Worksheets(4).Range("D" & Cnt).PasteSpecial xlPasteValues
ElseIf WsCnt = 2 Then
Worksheets(4).Range("L" & Cnt).PasteSpecial xlPasteValues
Else
Worksheets(4).Range("T" & Cnt).PasteSpecial xlPasteValues
End If
Application.CutCopyMode = False
Flag = True
Exit For
End If
Next i
If Flag Then
Exit For
End If
Next WsCnt
Next Cnt
erfix:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

If that's not a typo, I can trial again but it won't be until later today. Dave

 

[idoon3y]

That actually was not a type! Sheet 3's D:E to be pasted to sheet 4's T:U columns.