Copy range from sheet1 to sheet2 not deleting older dates and not doubling up.

Zeak

Zeak

New Member
Joined
Jan 21, 2020
Messages
19
Office Version
  1. 2016
Platform
  1. Windows
Hi All,

I've been searching though the web and though the different threads on here but I am unable to find anything that will work for me.
So if the magician's on here could help me with their wizardry, I would much appreciate it.
My problem is that I need to copy data in columns (Release Date, ID, Sequence, Parent Item, Qty Ordered) in sheet 1 to sheet 2 and as said in the title it needs to not overwrite the data in sheet 2 or duplicate what is already there.
Sheet 1 updates weekly and can have overlapping/same data from week to week.
Sheet 2 is basically a running history of orders, where sheet 1 is the current order we have from week to week and some of these order can push over to the following week.
Currently i'm selecting the rows that are new orders and pasting them into sheet 2, I also need to add comments to the rows pasted in sheet 2 that need to stay with that row of information (this can take a lot of time out of my week just keeping sheet 2 up to date when new orders come in), Please help.

Example.xlam
ABCDEFGHIJKL
1Release DateDayPrimary LineIDWork OrderSequenceDue DateParent ItemDescriptionWork Order StatusComponent StatusQty Ordered
228/12/2019Saturday211233566254060094128/12/2019113DRUM STDFPlanned Receipts8850
328/12/2019Saturday908377371611130348228/12/2019132DRUM T&CFPlanned Receipts17750
428/12/2019Saturday101834671746280011328/12/2019115DRUM PFFPlanned Receipts13867
528/12/2019Saturday2126|92033938885090043428/12/2019107DRUM GFGFPlanned Receipts13750
629/12/2019Sunday1003311321010220236129/12/2019102DRUM BFPlanned Receipts4009
729/12/2019Sunday35271337301371229/12/2019103DRUM GAFPlanned Receipts2112
829/12/2019Sunday100933512874030128329/12/2019105DRUM DGBFPlanned Receipts9150
929/12/2019Sunday100533348353260144429/12/2019113DRUM STDFPlanned Receipts13275
1030/12/2019Monday101435849308270009130/12/2019110DRUM PGFPlanned Receipts4250
111/01/2020Wednesday334332332900515/01/2020106BAR GFNo Status2380
121/01/2020Wednesday2106|21053290844225028211/01/2020112DRUM LFNo Status14400
131/01/2020Wednesday1016|10003581190826135721/01/2020101DRUM BOFNo Status11850
141/01/2020Wednesday10233436980611205931/01/2020117DRUM PCFNo Status3810
152/01/2020Thursday338081043001748/01/2020102BAR GFGFNo Status6000
162/01/2020Thursday358134182615084/01/2020101BAR BOFNo Status1390
172/01/2020Thursday3320137316005512/01/2020205DRUMED GFNo Status3
182/01/2020Thursday10193467173628001012/01/2020115DRUM PFFNo Status15657
192/01/2020Thursday3014714805005813/01/2020205DRUMED GFNo Status3050
202/01/2020Thursday1081|10803533243801009122/01/2020124DRUM MFNo Status19555
212/01/2020Thursday10173515549724005032/01/2020102DRUM BFNo Status4009
223/01/2020Friday354446680701399/01/2020107BAR L STDFNo Status3625
233/01/2020Friday358135582615224/01/2020112BAR PFNo Status1100
243/01/2020Friday3669716100401345/01/2020110BAR PFNo Status1360
254/01/2020Saturday2108|21073281273215005214/01/2020100DRUM ACFNo Status5426
Sheet1
 
Sort by date Sort by votes

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
See how this works :)

VBA Code: 
Public Sub ZeakMerge()
  Dim Source, Target, Row As Range, LastRow, InsertRowAddress As Long, IDList, IDColumn As String
  Set Source = ActiveWorkbook.Worksheets("Sheet1").UsedRange
  Set Target = ActiveWorkbook.Worksheets("Sheet2")
  LastRow = ActiveWorkbook.Worksheets("Sheet2").UsedRange.SpecialCells(xlCellTypeLastCell).Row
  IDList = "|"
  IDColumn = "D"
  For Each Row In Target.UsedRange.Rows 'Build Sheet2 list of items.
    IDList = IDList & Row.Cells(Row.Count, IDColumn) & "|"
  Next Row
  InsertRowAddress = LastRow + 1
  For Each Row In Source.Rows 'Copy items not on sheet2 already from sheet1
    If 0 = InStr(1, IDList, Row.Cells(Row.Count, IDColumn)) Then
      Row.Copy _
        Destination:=Target.Range("A" & InsertRowAddress)
      InsertRowAddress = InsertRowAddress + 1
    End If
  Next Row
  'Sort list
  Debug.Print Target.UsedRange.Rows.Count
  Target.UsedRange.Sort _
    key1:=Range(IDColumn & "2"), order1:=xlAscending, Header:=xlYes
End Sub
 
Upvote 0
See how this works :)

VBA Code: 
Public Sub ZeakMerge()
  Dim Source, Target, Row As Range, LastRow, InsertRowAddress As Long, IDList, IDColumn As String
  Set Source = ActiveWorkbook.Worksheets("Sheet1").UsedRange
  Set Target = ActiveWorkbook.Worksheets("Sheet2")
  LastRow = ActiveWorkbook.Worksheets("Sheet2").UsedRange.SpecialCells(xlCellTypeLastCell).Row
  IDList = "|"
  IDColumn = "D"
  For Each Row In Target.UsedRange.Rows 'Build Sheet2 list of items.
    IDList = IDList & Row.Cells(Row.Count, IDColumn) & "|"
  Next Row
  InsertRowAddress = LastRow + 1
  For Each Row In Source.Rows 'Copy items not on sheet2 already from sheet1
    If 0 = InStr(1, IDList, Row.Cells(Row.Count, IDColumn)) Then
      Row.Copy _
        Destination:=Target.Range("A" & InsertRowAddress)
      InsertRowAddress = InsertRowAddress + 1
    End If
  Next Row
  'Sort list
  Target.UsedRange.Sort _
    key1:=Range(IDColumn & ":" & IDColumn), order1:=xlAscending, Header:=xlYes
End Sub
 
Upvote 0
You code works great CSmith, I'm guessing I don't need the Debug line.

After doing this I realised that I need to sort Sheet 2 by Release Date and then Sequence.
VBA Code: 
Sub UpdateData()

Workbooks(ThisWorkbook.Name).RefreshAll

  Dim Source, Target, Row As Range, LastRow, InsertRowAddress As Long, IDList, DateColumn, IDColumn, SeqColumn As String
  Set Source = ActiveWorkbook.Worksheets("BCSV").UsedRange
  Set Target = ActiveWorkbook.Worksheets("SelectionData")
  LastRow = ActiveWorkbook.Worksheets("SelectionData").UsedRange.SpecialCells(xlCellTypeLastCell).Row
  IDList = "|"
  DateColumn = "A"
  IDColumn = "D"
  SeqColumn = "F"
  For Each Row In Target.UsedRange.Rows 'Build Sheet2 list of items.
    IDList = IDList & Row.Cells(Row.Count, IDColumn) & "|"
  Next Row
  InsertRowAddress = LastRow + 1
  For Each Row In Source.Rows 'Copy items not on sheet2 already from sheet1
    If 0 = InStr(1, IDList, Row.Cells(Row.Count, IDColumn)) Then
      Row.Copy _
        Destination:=Target.Range("A" & InsertRowAddress)
      InsertRowAddress = InsertRowAddress + 1
    End If
  Next Row
  'Sort list
  Target.UsedRange.Sort _
    key1:=Range(DateColumn & ":" & DateColumn), order1:=xlAscending, _
    key2:=Range(SeqColumn & ":" & SeqColumn), order2:=xlAscending, Header:=xlYes

End Sub

Is there a way to not copy some columns from Sheet 1, as I only need Release Date, ID, Sequence, Parent Item and Qty Ordered in Sheet 2.
 
Upvote 0
Yes, are you wanting just those 5 columns, and what is their related column on Sheet2?
Zeak said:
Is there a way to not copy some columns from Sheet 1, as I only need Release Date, ID, Sequence, Parent Item and Qty Ordered in Sheet 2.
Click to expand...
 
Upvote 0
CSmith said:
Yes, are you wanting just those 5 columns, and what is their related column on Sheet2?
Click to expand...
Sheet 1
Release Date = "A"
ID = "D"
Sequence = "F"
Parent Item = "H"
Qty Ordered = "L"
and probably need
Marks = "X"

Sheet 2
Release Date = "A"
Sequence = "B"
ID = "C"
Parent Item = "D"
Qty Ordered = "E"
Marks = "F"
then the column i have to add comments into
Comments = "G"
 
Upvote 0
How's this?
VBA Code: 
Public Sub UpdateData()

  Workbooks(ThisWorkbook.Name).RefreshAll

  Dim Source, Target, Row As Range, _
      LastRow, InsertRowAddress As Long, _
      IDList, DateColumn, IDColumn, SeqColumn As String
  Set Source = ActiveWorkbook.Worksheets("BCSV").UsedRange
  Set Target = ActiveWorkbook.Worksheets("SelectionData")
  LastRow = ActiveWorkbook.Worksheets("SelectionData").UsedRange.SpecialCells(xlCellTypeLastCell).Row
  IDList = "|"
  DateColumn = "A"
  tIDColumn = "B"
  sIDColumn = "D"
  SeqColumn = "F"
  For Each Row In Target.UsedRange.Rows 'Build Sheet2 list of items.
    IDList = IDList & Row.Cells(Row.Count, tIDColumn) & "|"
  Next Row
  InsertRowAddress = LastRow + 1
  For Each Row In Source.Rows 'Copy items not on sheet2 already from sheet1
    If 0 = InStr(1, IDList, Row.Cells(Row.Count, sIDColumn)) Then
      Target.Range("A" & InsertRowAddress).Offset(0, 0).Value = Row.Offset(0, 0).Value
      Target.Range("B" & InsertRowAddress).Offset(0, 0).Value = Row.Offset(0, 3).Value
      Target.Range("C" & InsertRowAddress).Offset(0, 0).Value = Row.Offset(0, 5).Value
      Target.Range("D" & InsertRowAddress).Offset(0, 0).Value = Row.Offset(0, 7).Value
      Target.Range("E" & InsertRowAddress).Offset(0, 0).Value = Row.Offset(0, 11).Value
      Target.Range("F" & InsertRowAddress).Offset(0, 0).Value = Row.Offset(0, 23).Value
      InsertRowAddress = InsertRowAddress + 1
    End If
  Next Row
  'Sort list
  Target.UsedRange.Sort _
    key1:=Range(DateColumn & ":" & DateColumn), order1:=xlAscending, _
    key2:=Range(SeqColumn & ":" & SeqColumn), order2:=xlAscending, Header:=xlYes

End Sub
 
Upvote 0
Can I ask what the two different IDColumn's are for? (tIDColumn, sIDColumn)
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Get values from specific date ranges
Replies
5
Views
334
kevin9999
K
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
193
bobaol
B
D
  • Question
Copy rows to a new workbook based on a date range of last three months from today()
Replies
8
Views
303
dandee14k
D
skyh3ck
  • Question
1st match column header, 2nd lookup a value in same column, 3rd return corresponding value from the very first column ?? need help
Replies
2
Views
263
skyh3ck
skyh3ck
I
  • Question
VBA - Copy Sheet from a workbook saved as a date - paste to specifically named sheet in another workbook based on the date
Replies
2
Views
200
Insurance Dave
I

Forum statistics

Threads
1,214,605
Messages
6,120,473
Members
448,967
Latest member
visheshkotha

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