Append Value from 3 worksheet to the Right of a New Worksheet

airforceone

airforceone

Board Regular
Joined
Feb 14, 2022
Messages
201
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Need help again mate.... hopefully my last hurdle to finishing my project (hope someone notice)

can anyone nudge me to the correct path :)
anyway what I'm trying to achieve is append records from 3 sheets into a new one (see sample table).
Copy product sheet to a new sheet then test for Buyer with 2 conditions (Control Number and Product Description) if condition is met then append buyer record to the last column corresponding control number and product description same with seller


UPLOAD.xlsx
ABC
1CONTROL NUMBERDATEPROD DESC
2A00012017.02.16Apple - Green
3A00012017.02.16Apple - Red
4A00012017.02.16Apple - Black
5A00022017.10.13Mango
6A00032019.10.30Buko
7A00042014.02.05Blueberries
8A00052014.02.05Avocado
9A00062013.06.19Papaya
10A00072011.04.01Lychee
11A00082011.05.30Pineapple
12A00092022.04.28Durian
13A00102022.05.24Orange - Small
14A00102022.05.24Orange - Large
15A00102022.05.24Orange - Medium
PRODUCT


UPLOAD.xlsx
ABCD
1CONTROL NUMBERDATE COMMITTEDPROD DESCSELLER LAST NAME
2A00012017.02.16Apple - GreenNOVEMBER
3A00022017.10.13MangoLIMA
4A00032019.10.30BukoPAPA
5A00042014.02.05BlueberriesROMEO
6A00052014.02.05AvocadoCHARLIE
7A00062013.06.19PapayaTWITTER
8A00072011.04.01LycheeGAMA
9A00082011.05.30PineappleAMAZON
10A00092022.04.28DurianDOE
11A00102022.05.24Orange - SmallPETER
12A00102022.05.24Orange - LargeCOM
13A00102022.05.24Orange - MediumCAMI
SELLER


UPLOAD.xlsx
ABCD
1CONTROL NUMBERDATE COMMITTEDPROD DESCBUYER LAST NAME
2A00012017.02.16Apple - GreenEBAY
3A00012017.02.16Apple - RedZETA
4A00012017.02.16Apple - BlackMIKE
5A00022017.10.13MangoECHO
6A00032019.10.30BukoHERNANDEZ
7A00042014.02.05BlueberriesROMEO
8A00052014.02.05AvocadoNOVEMBER
9A00062013.06.19PapayaROMEO
10A00072011.04.01LycheeEBAY
11A00082011.05.30PineappleBRABO
12A00092022.04.28DurianLIMA
13A00102022.05.24Orange - SmallPAPA
14A00102022.05.24Orange - LargeCHARLIE
15A00102022.05.24Orange - MediumPero
BUYER


UPLOAD.xlsx
ABCDE
1CONTROL NUMBERDATEPROD DESCSELLER LAST NAMEBUYER LAST NAME
2A00012017.02.16Apple - GreenNOVEMBEREBAY
3A00012017.02.16Apple - RedNOVEMBERZETA
4A00012017.02.16Apple - BlackNOVEMBERMIKE
5A00022017.10.13MangoLIMAECHO
6A00032019.10.30BukoPAPAHERNANDEZ
7A00042014.02.05BlueberriesROMEOROMEO
8A00052014.02.05AvocadoCHARLIENOVEMBER
9A00062013.06.19PapayaTWITTERROMEO
10A00072011.04.01LycheeGAMAEBAY
11A00082011.05.30PineappleAMAZONBRABO
12A00092022.04.28DurianDOELIMA
13A00102022.05.24Orange - SmallPETERPAPA
14A00102022.05.24Orange - LargeCOMCHARLIE
15A00102022.05.24Orange - MediumCAMIPero
OUTPUT
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
This might point you in the right direction? Formula approach - and you'll need to adjust all the ranges to suit your actual data set. Output sheet shown below.
Book1
ABCDE
1CONTROL NUMBERDATEPROD DESCSELLER LAST NAMEBUYER LAST NAME
2A00012017.02.16Apple - GreenNOVEMBEREBAY
3A00012017.02.16Apple - RedNOVEMBERZETA
4A00012017.02.16Apple - BlackNOVEMBERMIKE
5A00022017.10.13MangoLIMAECHO
6A00032019.10.30BukoPAPAHERNANDEZ
7A00042014.02.05BlueberriesROMEOROMEO
8A00052014.02.05AvocadoCHARLIENOVEMBER
9A00062013.06.19PapayaTWITTERROMEO
10A00072011.04.01LycheeGAMAEBAY
11A00082011.05.30PineappleAMAZONBRABO
12A00092022.04.28DurianDOELIMA
13A00102022.05.24Orange - SmallPETERPAPA
14A00102022.05.24Orange - LargePETERCHARLIE
15A00102022.05.24Orange - MediumPETERPero
OUTPUT
Cell Formulas
RangeFormula
A2:C15A2=PRODUCT!A2:C15
D2:D15D2=VLOOKUP(A2,SELLER!$A$2:$D$13,4,FALSE)
E2:E15E2=INDEX(BUYER!$D$2:$D$15,MATCH(1,(BUYER!$A$2:$A$15=A2)*(BUYER!$C$2:$C$15=C2),0))
Dynamic array formulas.
 
Upvote 0
kevin9999 said:
This might point you in the right direction? Formula approach - and you'll need to adjust all the ranges to suit your actual data set. Output sheet shown below.
Book1
ABCDE
1CONTROL NUMBERDATEPROD DESCSELLER LAST NAMEBUYER LAST NAME
2A00012017.02.16Apple - GreenNOVEMBEREBAY
3A00012017.02.16Apple - RedNOVEMBERZETA
4A00012017.02.16Apple - BlackNOVEMBERMIKE
5A00022017.10.13MangoLIMAECHO
6A00032019.10.30BukoPAPAHERNANDEZ
7A00042014.02.05BlueberriesROMEOROMEO
8A00052014.02.05AvocadoCHARLIENOVEMBER
9A00062013.06.19PapayaTWITTERROMEO
10A00072011.04.01LycheeGAMAEBAY
11A00082011.05.30PineappleAMAZONBRABO
12A00092022.04.28DurianDOELIMA
13A00102022.05.24Orange - SmallPETERPAPA
14A00102022.05.24Orange - LargePETERCHARLIE
15A00102022.05.24Orange - MediumPETERPero
OUTPUT
Cell Formulas
RangeFormula
A2:C15A2=PRODUCT!A2:C15
D2:D15D2=VLOOKUP(A2,SELLER!$A$2:$D$13,4,FALSE)
E2:E15E2=INDEX(BUYER!$D$2:$D$15,MATCH(1,(BUYER!$A$2:$A$15=A2)*(BUYER!$C$2:$C$15=C2),0))
Dynamic array formulas.
Click to expand...
appreciate the effort mate, but if I may add would it be possible in VBA?
 
Upvote 0
Try the following on a copy of your workbook
VBA Code: 
Option Explicit
Sub airforceone()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("PRODUCT")
    Set ws2 = Worksheets("OUTPUT")
    
    'Clear the OUTPUT sheet first
    ws2.Cells.ClearContents
    ws2.Range("A1").Resize(, 5) = Array("CONTROL NUMBER", "DATE", "PROD DESC", "SELLER LAST NAME", "BUYER LAST NAME")
    
    'Get the new data
    Dim LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws2.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    If LRow > 1 Then
        ws1.Range(ws1.Cells(2, 1), ws1.Cells(LRow, LCol)).Copy ws2.Range("A2")
    Else
        MsgBox "No records found to copy"
        Exit Sub
    End If
    
    'Get the Seller last name
    With ws2.Range("D2:D" & LRow)
        .Formula2R1C1 = "=IFERROR(INDEX(SELLER!R2C4:R" & LRow & "C4,MATCH(1,(SELLER!R2C1:R" & LRow & "C1=RC1)*(SELLER!R2C3:R" & LRow & "C3=RC3),0)),""Seller not listed"")"
        .Value2 = .Value2
    End With
    
    'Get the Buyer last name
    With ws2.Range("E2:E" & LRow)
        .Formula2R1C1 = "=INDEX(BUYER!R2C4:R" & LRow & "C4,MATCH(1,(BUYER!R2C1:R" & LRow & "C1=RC1)*(BUYER!R2C3:R" & LRow & "C3=RC3),0))"
        .Value2 = .Value2
    End With
    
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
kevin9999 said:
Try the following on a copy of your workbook
VBA Code: 
Option Explicit
Sub airforceone()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("PRODUCT")
    Set ws2 = Worksheets("OUTPUT")
   
    'Clear the OUTPUT sheet first
    ws2.Cells.ClearContents
    ws2.Range("A1").Resize(, 5) = Array("CONTROL NUMBER", "DATE", "PROD DESC", "SELLER LAST NAME", "BUYER LAST NAME")
   
    'Get the new data
    Dim LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws2.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    If LRow > 1 Then
        ws1.Range(ws1.Cells(2, 1), ws1.Cells(LRow, LCol)).Copy ws2.Range("A2")
    Else
        MsgBox "No records found to copy"
        Exit Sub
    End If
   
    'Get the Seller last name
    With ws2.Range("D2:D" & LRow)
        .Formula2R1C1 = "=IFERROR(INDEX(SELLER!R2C4:R" & LRow & "C4,MATCH(1,(SELLER!R2C1:R" & LRow & "C1=RC1)*(SELLER!R2C3:R" & LRow & "C3=RC3),0)),""Seller not listed"")"
        .Value2 = .Value2
    End With
   
    'Get the Buyer last name
    With ws2.Range("E2:E" & LRow)
        .Formula2R1C1 = "=INDEX(BUYER!R2C4:R" & LRow & "C4,MATCH(1,(BUYER!R2C1:R" & LRow & "C1=RC1)*(BUYER!R2C3:R" & LRow & "C3=RC3),0))"
        .Value2 = .Value2
    End With
   
    Application.ScreenUpdating = True
End Sub
Click to expand...
Runtime Error 1004
Application-Defined or Object-Defined Error

VBA Code: 
        .Formula2R1C1 = "=IFERROR(INDEX(SELLER!R2C4:R" & LRow & "C4,MATCH(1,(SELLER!R2C1:R" & LRow & "C1=RC1)*(SELLER!R2C3:R" & LRow & "C3=RC3),0)),""Seller not listed"")"
 
Upvote 0
Check this code to see if it works.

Book2.xlsm

drive.google.com drive.google.com

VBA Code: 
Option Explicit
Sub test()
Dim lr&, i&, rng, res(), id As String, sp
Dim dic As Object, key, ws As Worksheet
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("PRODUCT")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:C" & lr).Value2
    For i = 1 To UBound(rng)
        id = rng(i, 1) & "|" & rng(i, 2) & "|" & rng(i, 3)
        If Not dic.exists(id) Then
            dic.Add id, "|"
        End If
    Next
End With
For Each ws In Sheets
    If ws.Name Like "*ER" Then
        lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
        rng = ws.Range("A2:D" & lr).Value2
        For i = 1 To UBound(rng)
            id = rng(i, 1) & "|" & rng(i, 2) & "|" & rng(i, 3)
            sp = Split(dic(id), "|")
            dic(id) = IIf(ws.Name = "SELLER", rng(i, 4) & "|" & sp(1), sp(0) & "|" & rng(i, 4))
        Next
    End If
Next
i = 1: Sheets("OUTPUT").Activate
With ActiveSheet
    .Range("A2:E10000").ClearContents
    For Each key In dic.keys
        i = i + 1: sp = Split(key, "|")
        .Cells(i, 1).Value = sp(0)
        .Cells(i, 2).Value = sp(1)
        .Cells(i, 3).Value = sp(2)
        .Cells(i, 4).Value = Split(dic(key), "|")(0)
        .Cells(i, 5).Value = Split(dic(key), "|")(1)
        If .Cells(i, 4).Value = "" Then .Cells(i, 4).Value = .Cells(i - 1, 4).Value
    Next
End With
End Sub
 
Upvote 0
Solution
airforceone said:
Runtime Error 1004
Application-Defined or Object-Defined Error

VBA Code: 
        .Formula2R1C1 = "=IFERROR(INDEX(SELLER!R2C4:R" & LRow & "C4,MATCH(1,(SELLER!R2C1:R" & LRow & "C1=RC1)*(SELLER!R2C3:R" & LRow & "C3=RC3),0)),""Seller not listed"")"
Click to expand...
The code worked on a file I put together based on your XL2BB samples in post #1. Could you share your actual file via Google Drive, Dropbox or similar file sharing platform?
 
Upvote 0
y
bebo021999 said:
Check this code to see if it works.

Book2.xlsm

drive.google.com drive.google.com

VBA Code: 
Option Explicit
Sub test()
Dim lr&, i&, rng, res(), id As String, sp
Dim dic As Object, key, ws As Worksheet
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("PRODUCT")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:C" & lr).Value2
    For i = 1 To UBound(rng)
        id = rng(i, 1) & "|" & rng(i, 2) & "|" & rng(i, 3)
        If Not dic.exists(id) Then
            dic.Add id, "|"
        End If
    Next
End With
For Each ws In Sheets
    If ws.Name Like "*ER" Then
        lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
        rng = ws.Range("A2:D" & lr).Value2
        For i = 1 To UBound(rng)
            id = rng(i, 1) & "|" & rng(i, 2) & "|" & rng(i, 3)
            sp = Split(dic(id), "|")
            dic(id) = IIf(ws.Name = "SELLER", rng(i, 4) & "|" & sp(1), sp(0) & "|" & rng(i, 4))
        Next
    End If
Next
i = 1: Sheets("OUTPUT").Activate
With ActiveSheet
    .Range("A2:E10000").ClearContents
    For Each key In dic.keys
        i = i + 1: sp = Split(key, "|")
        .Cells(i, 1).Value = sp(0)
        .Cells(i, 2).Value = sp(1)
        .Cells(i, 3).Value = sp(2)
        .Cells(i, 4).Value = Split(dic(key), "|")(0)
        .Cells(i, 5).Value = Split(dic(key), "|")(1)
        If .Cells(i, 4).Value = "" Then .Cells(i, 4).Value = .Cells(i - 1, 4).Value
    Next
End With
End Sub
Click to expand...
your code works great! but hurts my brain so painfully :)
is there a way to scale the code a bit? i still have a few columns/fields that should be included in the output....
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA code to determine InDesign Layout
Replies
6
Views
377
Akuini
Akuini
A
  • Question Question
Make a new worksheet at every page break in a worksheet & name each sheet after a value from a cell.
Replies
6
Views
426
Arcomvi
A
J
  • Question Question
Macro to copy values from multiple sheets in a workbook to a new worksheet in the same workbook
Replies
3
Views
313
MARK858
MARK858
S
  • Question Question
Copy and paste one row from filtered table as new a new row, always in row 3, to protected worksheet
Replies
0
Views
545
SonntagC
S
D
  • Solved
Cdbl textBox showing as Text Error in Worksheet
Replies
4
Views
818
RoryA
RoryA

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

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