Macro/VBA Require to Combine Data in new sheet from Two Different Sheet, basically as per coverage need to combine as per details shown below

R

rajendradk9

New Member
Joined
Aug 3, 2013
Messages
39
Book2
ABCDEFGHIJKLMNOPQRST
1Sheet1+Sheet2=Combine Data as per below
2Sheet1Sheet2Remark (Just For Understanding)
3Tran NOLN NOModel NOQtyTran NOLN NOModel NOQtyDateTran NOLN NOModel NOQtyTran NOLN NODate
4SO11Laptop10PO11Mouse701-06-2023SO11Laptop10PO1301-12-2023Coverage
5SO12Desktop5PO12CPU5001-12-2024SO12Desktop3PO1431-03-2024Data 1 line should get split as per Data 2 available Qty in Sequence
6SO13KeyPad10PO13Laptop1101-12-2023SO12Desktop2PO2115-05-2023Data 1 line should get split as per Data 2 available Qty in Sequence
7SO21Mouse5PO14Desktop331-03-2024SO13KeyPad10PO2207-07-2023Coverage
8SO22CPU10PO21Desktop215-05-2023SO21Mouse5PO1101-06-2023Coverage
9SO31Laptop5PO22KeyPad1107-07-2023SO22CPU10PO1201-12-2024Coverage
10SO41KeyPad5PO23Laptop407-07-2023SO31Laptop1PO1301-12-2023Coverage
11SO42Mouse10SO31Laptop4PO2307-07-2023Coverage
12SO43CPU5SO41KeyPad1PO2207-07-2023Data 1 line should get split as per Data 2 available Qty in Sequence
13SO44Antivirus5SO41KeyPad4No Coverage
14SO42Mouse2PO1101-06-2023Data 1 line should get split as per Data 2 available Qty in Sequence
15SO42Mouse8No Coverage
16SO43CPU5PO1201-12-2024Coverage
17SO44Antivirus5No Coverage
18
Sheet1
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sort by date Sort by votes
The following macro is assuming that the data in both sheets starts in cell A1.
On sheet 3 you should put the headings only once.

VBA Code: 
Sub CombineData()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, k As Long, qty1 As Double, qty2 As Double
  
  a = Sheets("Sheet1").Range("A2:D" & Sheets("Sheet1").Range("A" & Rows.Count).End(3).Row).Value
  b = Sheets("Sheet2").Range("A2:E" & Sheets("Sheet2").Range("A" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1) * 10, 1 To 7)
  
  For i = 1 To UBound(a, 1)
    qty1 = a(i, 4)
    For j = 1 To UBound(b, 1)
      If a(i, 3) = b(j, 3) And b(j, 4) > 0 Then
        If qty1 < b(j, 4) Then
          qty2 = a(i, 4)
          b(j, 4) = b(j, 4) - qty1
          qty1 = 0
        Else
          qty2 = b(j, 4)
          qty1 = qty1 - b(j, 4)
          b(j, 4) = 0
        End If
        k = k + 1
        c(k, 1) = a(i, 1)
        c(k, 2) = a(i, 2)
        c(k, 3) = a(i, 3)
        c(k, 4) = qty2
        c(k, 5) = b(j, 1)
        c(k, 6) = b(j, 2)
        c(k, 7) = b(j, 5)
        If qty1 = 0 Then Exit For
      End If
    Next
    If qty1 > 0 Then
      k = k + 1
      c(k, 1) = a(i, 1)
      c(k, 2) = a(i, 2)
      c(k, 3) = a(i, 3)
      c(k, 4) = qty1
    End If
  Next
  
  With Sheets("Sheet3")
    .Rows("2:" & Rows.Count).ClearContents
    .Range("A2").Resize(k, UBound(c, 2)).Value = c
  End With
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

"the good listener few words"
"al buen entendedor pocas palabras"
-dicho popular-
​
 
Upvote 1
Solution
For below Sample Data Macro is not working, can you please help to add below condition in macro, would be very helpful

Book1
ABCDEFGHIJ
1Sheet1Sheet2
2Tran NOLN NOModel NOQtyTran NOLN NOModel NOQtyDate
3SO122LAPTOP1PO113LAPTOP117-05-2024
4SO26LAPTOP5PO114LAPTOP117-05-2024
5SO34LAPTOP5PO115LAPTOP117-05-2024
6SO431LAPTOP5PO130LAPTOP517-05-2024
7SO531LAPTOP1PO26LAPTOP231-10-2023
8SO626LAPTOP1PO211LAPTOP831-10-2023
Sheet1
 
Upvote 0
which condition?

If it's a new condition not explained in the original post then please create a new thread.
 
Upvote 0
Dear Sir, regret for confusion, there's no new condition, which macro solution you've given working for sample data which is small set of data, in actual when I'm trying on actual data somehow this is not working perfect, my observation is that if same part is repeating multiple times (frequency >2 times) in this case this is not working, also total Qty should not exceed the Sheet1 Data, as shown in beginning sample, Hope you got my point, request you to have look again below data FYR, incase if you need anymore details let me know, in actual data frequency may increase for same part just keep this in mind while doing this. Loking forward fo valuable support, Thanks in Advance.

Sheet1Sheet2Desired Output
Tran NOLN NOModel NOQtyTran NOLN NOModel NOQtyDateTran NOLN NOModel NOQtyTran NOLN NODate
SO11LAPTOP1,000PO14LAPTOP70017-09-2023SO11LAPTOP700PO1417-09-2023
SO12Antivirus500PO15LAPTOP25017-09-2023SO11LAPTOP250PO1517-09-2023
SO21CPU973PO213DESKTOP2716-03-2024SO11LAPTOP50
SO32DESKTOP4PO229KeyPad2427-09-2023SO12Antivirus500PO91001-09-2023
SO42DESKTOP32PO238CPU50027-09-2023SO21CPU500PO23827-09-2023
SO53DESKTOP69PO242KeyPad127-09-2023SO21CPU473PO25027-09-2023
SO510KeyPad33PO247KeyPad127-09-2023SO32DESKTOP4PO21316-03-2024
SO63DESKTOP18PO250CPU50027-09-2023SO42DESKTOP23PO21316-03-2024
SO69KeyPad5PO251CPU50027-09-2023SO42DESKTOP9PO3301-03-2024
SO73DESKTOP15PO33DESKTOP3601-03-2024SO53DESKTOP27PO3301-03-2024
SO79KeyPad5PO39KeyPad515-12-2023SO53DESKTOP42PO4101-03-2024
SO83DESKTOP21PO41DESKTOP6901-03-2024SO510KeyPad24PO22927-09-2023
SO89KeyPad7PO49DESKTOP1801-03-2024SO510KeyPad1PO24227-09-2023
SO92DESKTOP14PO426KeyPad4401-09-2023SO510KeyPad1PO24727-09-2023
SO97KeyPad5PO52DESKTOP1516-03-2024SO510KeyPad5PO3915-12-2023
SO103DESKTOP79PO53DESKTOP3516-03-2024SO510KeyPad2PO42601-09-2023
SO1010KeyPad37PO523KeyPad1726-09-2023SO63DESKTOP18PO4101-03-2024
SO113DESKTOP27PO524KeyPad1926-09-2023SO69KeyPad5PO42601-09-2023
SO119KeyPad9PO534DESKTOP3516-03-2024SO73DESKTOP9PO4101-03-2024
SO121DESKTOP37PO542KeyPad3626-09-2023SO73DESKTOP6PO4901-03-2024
SO126KeyPad21PO554DESKTOP2116-03-2024SO79KeyPad5PO42601-09-2023
SO133DESKTOP15PO560KeyPad726-09-2023SO83DESKTOP12PO4901-03-2024
SO137KeyPad2PO567DESKTOP2816-03-2024SO83DESKTOP9PO5216-03-2024
SO143DESKTOP15PO573KeyPad926-09-2023SO89KeyPad7PO42601-09-2023
SO153DESKTOP15PO582DESKTOP1616-03-2024SO92DESKTOP6PO5216-03-2024
SO163DESKTOP15PO588KeyPad526-09-2023SO92DESKTOP8PO5316-03-2024
SO167KeyPad2PO63DESKTOP7923-02-2024SO97KeyPad5PO42601-09-2023
SO173DESKTOP90PO610KeyPad3712-01-2024SO103DESKTOP27PO5316-03-2024
SO1710KeyPad41PO623KeyPad112-01-2024SO103DESKTOP35PO53416-03-2024
SO181DESKTOP35PO78KeyPad112-01-2024SO103DESKTOP17PO55416-03-2024
SO186KeyPad19PO713DESKTOP3723-02-2024SO1010KeyPad20PO42601-09-2023
SO193DESKTOP27PO718KeyPad2112-01-2024SO1010KeyPad17PO52326-09-2023
SO199KeyPad9PO726DESKTOP2723-02-2024SO113DESKTOP4PO55416-03-2024
SO204DESKTOP90PO732KeyPad912-01-2024SO113DESKTOP23PO56716-03-2024
SO2010KeyPad37PO742DESKTOP1523-02-2024SO119KeyPad9PO52426-09-2023
SO214DESKTOP86PO746KeyPad112-01-2024SO121DESKTOP5PO56716-03-2024
SO2110KeyPad36PO812KeyPad101-09-2023SO121DESKTOP16PO58216-03-2024
SO223DESKTOP21PO99KeyPad3301-09-2023SO121DESKTOP16PO6323-02-2024
SO229KeyPad7PO910Antivirus50001-09-2023SO126KeyPad10PO52426-09-2023
SO233DESKTOP28PO108KeyPad114-07-2023SO126KeyPad11PO54226-09-2023
SO239KeyPad9PO1110KeyPad301-09-2023SO133DESKTOP15PO6323-02-2024
SO241DESKTOP46PO1212KeyPad320-10-2023SO137KeyPad2PO54226-09-2023
SO246KeyPad24PO139KeyPad515-12-2023SO143DESKTOP15PO6323-02-2024
SO253DESKTOP16PO1417KeyPad224-11-2023SO153DESKTOP15PO6323-02-2024
SO266KeyPad1SO163DESKTOP15PO6323-02-2024
SO278KeyPad1SO167KeyPad2PO54226-09-2023
SO282KeyPad1SO173DESKTOP3PO6323-02-2024
SO2814KeyPad1SO173DESKTOP37PO71323-02-2024
SO292KeyPad1SO173DESKTOP27PO72623-02-2024
SO302KeyPad1SO173DESKTOP15PO74223-02-2024
SO3014KeyPad1SO173DESKTOP8
SO316KeyPad1SO1710KeyPad21PO54226-09-2023
SO326KeyPad1SO1710KeyPad7PO56026-09-2023
SO338KeyPad1SO1710KeyPad9PO57326-09-2023
SO346KeyPad2SO1710KeyPad4PO58826-09-2023
SO351KeyPad1SO181DESKTOP35
SO364KeyPad1SO186KeyPad1PO58826-09-2023
SO378KeyPad1SO186KeyPad18PO61012-01-2024
SO386KeyPad2SO193DESKTOP27
SO396KeyPad2SO199KeyPad9PO61012-01-2024
SO204DESKTOP90
SO2010KeyPad10PO61012-01-2024
SO2010KeyPad1PO62312-01-2024
SO2010KeyPad1PO7812-01-2024
SO2010KeyPad21PO71812-01-2024
SO2010KeyPad4PO73212-01-2024
SO214DESKTOP86
SO2110KeyPad5PO73212-01-2024
SO2110KeyPad1PO74612-01-2024
SO2110KeyPad1PO81201-09-2023
SO2110KeyPad29PO9901-09-2023
SO223DESKTOP21
SO229KeyPad4PO9901-09-2023
SO229KeyPad1PO10814-07-2023
SO229KeyPad2PO111001-09-2023
SO233DESKTOP28
SO239KeyPad1PO111001-09-2023
SO239KeyPad3PO121220-10-2023
SO239KeyPad5PO13915-12-2023
SO241DESKTOP46
SO246KeyPad2PO141724-11-2023
SO246KeyPad22
SO253DESKTOP16
SO266KeyPad1
SO278KeyPad1
SO282KeyPad1
SO2814KeyPad1
SO292KeyPad1
SO302KeyPad1
SO3014KeyPad1
SO316KeyPad1
SO326KeyPad1
SO338KeyPad1
SO346KeyPad2
SO351KeyPad1
SO364KeyPad1
SO378KeyPad1
SO386KeyPad2
SO396KeyPad2
 
Upvote 0
Forgive the delay.
Here the macro with the changes:

VBA Code: 
Sub CombineData()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, k As Long, qty1 As Double, qty2 As Double
  
  a = Sheets("Sheet1").Range("A2:D" & Sheets("Sheet1").Range("A" & Rows.Count).End(3).Row).Value
  b = Sheets("Sheet2").Range("A2:E" & Sheets("Sheet2").Range("A" & Rows.Count).End(3).Row).Value
  ReDim c(1 To UBound(a, 1) * 10, 1 To 7)
    
  For i = 1 To UBound(a, 1)
    qty1 = a(i, 4)
    For j = 1 To UBound(b, 1)
      If a(i, 3) = b(j, 3) And b(j, 4) > 0 Then
        If qty1 <= b(j, 4) Then
          qty2 = qty1
          b(j, 4) = b(j, 4) - qty1
          qty1 = 0
        Else
          qty2 = b(j, 4)
          qty1 = qty1 - b(j, 4)
          b(j, 4) = 0
        End If
        k = k + 1
        c(k, 1) = a(i, 1)
        c(k, 2) = a(i, 2)
        c(k, 3) = a(i, 3)
        c(k, 4) = qty2
        c(k, 5) = b(j, 1)
        c(k, 6) = b(j, 2)
        c(k, 7) = b(j, 5)
        If qty1 = 0 Then Exit For
      End If
    Next
    If qty1 > 0 Then
      k = k + 1
      c(k, 1) = a(i, 1)
      c(k, 2) = a(i, 2)
      c(k, 3) = a(i, 3)
      c(k, 4) = qty1
    End If
  Next
  
  With Sheets("Sheet3")
    .Range("A2:G" & Rows.Count).ClearContents
    .Range("A2").Resize(k, UBound(c, 2)).Value = c
  End With
End Sub

--------------
Regards
Dante Amor
--------------
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Question Question
Copy and Paste Multiple sheet data in one sheet Formula
Replies
7
Views
335
vishu
V
J
  • Solved
Sorting a Lot of data into multiple sheets (up to 200k lines)
Replies
4
Views
335
JMWh1t3
J
Dazzawm
  • Solved
Macro To Find Latest Date To Corresponding Data In Column B And Add To Sheet 2
Replies
7
Views
341
Fuji
F
A
  • Solved
Macro getting stuck on average when no data is present
Replies
5
Views
423
amphead
A
O
  • Solved
Macro to extract repeating invoice numbers and details
Replies
4
Views
235
Omar M
O

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

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