Copy new data to worksheet

[mrdata]

If I have a worksheet that contains this:

Apples
Oranges
Pears

And I have another worksheet that contains:

Apples
Oranges
Pears
Tangerines

How do I scan the worksheet and find Tangerine isn't on the first
worksheet
and have it copy to the first worksheet without recopying Apples
Oranges Pears

I don't even know where to start this is a simple example of a more
complex worksheet.

Thanks
Charles

 

[Ron de Bruin]

Maybe
http://www.rondebruin.nl/copy5.htm

 

[mrdata]

I tried the code on the website but I can't make it work will you tal
me through the steps I need to make this work?
I really need this for my job.

I think the code needs to be modified for my needs here is what I hav
thus far and it does nothing.

'This sub use the function LastRow
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim Str As String

Set WS1 = Sheets("Last Week") '<<< This is the destinatio
worksheet
Set WS2 = Sheets("L") '<<< This is the worksheet I want to pul
Data from
'A1 is the top left cell of your filter range and the header of th
first column
Set rng1 = WS1.Range("A5").CurrentRegion '<<< Change
Str = "Code" '<<< Change

'Close AutoFilter first
WS1.AutoFilterMode = False

'This example filter on the first column in the range (change th
field if needed)
rng1.AutoFilter Field:=5, Criteria1:=Str

With WS1.AutoFilter.Range
On Error Resume Next
' This example will not copy the header row
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1
.Columns.Count) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
'Copy the cells
rng2.Copy WS2.Range("A" & LastRow(WS2) + 1)
'Delete the rows in WS1
rng2.EntireRow.Delete
End If
End With
WS1.AutoFilterMode = Fals

 

[Ron de Bruin]

WS1 is the sheet with data and ws2 the destination sheet

Try my test code first in a test workbook

 

[mrdata]

Here is the module code I am calling the sub import from a command
button on the destination worksheet "Last Week"

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A2"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Sub import()
'This sub use the function LastRow
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim Str As String

Set WS1 = Sheets("L") '<<< Change
Set WS2 = Sheets("Last Week") '<<< Change
'A1 is the top left cell of your filter range and the header of the
first column
Set rng1 = WS1.Range("A2:M350").CurrentRegion '<<< Change
Str = "Code" '<<< Change

How can I make it filter on every code number under the code column ?
Currently I have to change this to one of the code cloumn values such
as 400

Also I need the imported data to go on the last empty row they start
out at the top and push all the previously imported data down.
I appreciate you helping me with this I really need this for my job at
work .


'Close AutoFilter first
WS1.AutoFilterMode = False

'This example filter on the first column in the range (change the
field if needed)
rng1.AutoFilter Field:=1, Criteria1:=Str

With WS1.AutoFilter.Range
On Error Resume Next
' This example will not copy the header row
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1,
..Columns.Count) _
..SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
'Copy the cells
rng2.Copy WS2.Range("A" & LastRow(WS2) + 1)
'Delete the rows in WS1
rng2.EntireRow.Delete
End If
End With
WS1.AutoFilterMode = False
End Sub

 

[Ron de Bruin]

How can I make it filter on every code number under the code column ?
See
http://www.rondebruin.nl/copy5.htm#existing

 

[mrdata]

I need more specific instructions
Just giving me the website doesn't work because there are multipl
examples
None of which seem to be working for me.
I don't mean they won't work at all they just won't do what I need an
I don't know how to modify the code to make it work.

I need the source worksheet to compare the destination worksheet dat
and only import the rows that are not already in the destinatio
worksheet
The source worksheet range is A2:M350
The destination worksheet range is A5:M350

The header rows contain the same header values on both sheets.

I really need your help on this my boss is on my back about it.

Thanks
Charle

 

[Ron de Bruin]

Hi

Sorry for the late response (very busy)

Try this on a test workbook with sheets named destination and source

Sub test()
Dim cell As Range
On Error Resume Next
For Each cell In Sheets("source").Range("A:A").SpecialCells(xlCellTypeConstants)
If Application.WorksheetFunction.CountIf(Sheets("destination").Range("A:A"), cell.Value) > 0 Then
'do nothing
Else
Sheets("source").Rows(cell.Row).Copy Sheets("destination").Cells(LastRow(Sheets("destination")) + 1, 1)
End If
Next cell
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

 

[mrdata]

This is the data from the destination worksheet

Code Reason style Greige . Fin Roll . Bac width length sq_yds Fin
Date Coater sh user id

400 LATEX ON
FACE TREA 06425339 29922393 AB 12.00 16.00 21.33 02/21/06 C01 1 CQTB1
400 LATEX ON
FACE 00335 06414914 29921892 AB 12.00 14.00 18.66 02/18/06 C01 4 CQVMIREL
400 LATEX ON
FACE 00335 06429173 29935078 AB 12.00 59.00 78.66 02/18/06 C01 4 CQTB1
400 LATEX ON
FACE 00335 06429173 29935097 AB 12.00 64.00 85.33 02/18/06 C01 4 CQJM7
408 DELAMINATION/LOOSE EXCA 06323583 29913828 AB 12.00 136.00 181.33 02/17/06 C01 4 CQBM5
408 DELAMINATION/LOOSE EXCA 06323583 29925410 AB 12.00 32.00 42.66 02/17/06 C01 4 CQJH1
408 DELAMINATION/LOOSE EXCA 06323583 29920591 AB 12.00 95.00 126.66 02/17/06 C01 4 SRMIKEJ
408 DELAMINATION/LOOSE P2805 06416362 29931181 AB 12.00 62.07 83.44 02/22/06 C01 3 SRLS6
408 DELAMINATION/LOOSE ULTI 06419099 29913583 AB 12.00 146.00 194.66 02/17/06 C01 4 CQVMIREL
408 DELAMINATION/LOOSE ULTI 06419099 29923162 AB 12.00 11.00 14.66 02/17/06 C01 4 CQVMIREL
408 DELAMINATION/LOOSE ULTI 06419099 29924968 AB 12.00 146.00 194.66 02/17/06 C01 4 CQSM1
408 DELAMINATION/LOOSE 00180 06409026 29928107 HP 12.00 17.04 23.11 02/22/06 C01 3 SRMARTHAR
408 DELAMINATION/LOOSE 00335 06429175 29915441 AB 12.00 214.05 285.88 02/18/06 C01 4 CQVMIREL
408 DELAMINATION/LOOSE 01024 06415794 29868338 AB 12.00 26.00 34.66 02/06/06 C01 2 SRRQUINT
408 DELAMINATION/LOOSE 01064 06404892 29910673 AB 12.00 100.02 133.55 02/16/06 C01 2 SRRQUINT
429 SHREDDED
EDGES KICO 06409966 29895852 AB 12.00 13.00 17.33 2/14/2006 C01 3 CQBM5
443 DELAM (LOOSE
EDGES) 00181 06427218 29922928 AB 12.00 18.06 24.66 2/20/2006 C01 1 CQCM5
402 PULLED
ENDS 50197 06434108 29921757 AB 15.00 13.03 22.08 2/20/2006 C03 2 SRTWESS
403 HOLES 50197 06419942 29921445 AB 15.00 9.00 15.00 2/9/2006 C03 3 SRGF1

The last four rows were imported by the code

This is the source data


Code Reason style Greige . Fin Roll . Bac width length sq_yds Fin
Date Coater sh user id

400 LATEX ON
FACE TREA 06425339 29922393 AB 12.00 16.00 21.33 02/21/06 C01 1 CQTB1
400 LATEX ON
FACE 00335 06414914 29921892 AB 12.00 14.00 18.66 02/18/06 C01 4 CQVMIREL
400 LATEX ON
FACE 00335 06429173 29935078 AB 12.00 59.00 78.66 02/18/06 C01 4 CQTB1
400 LATEX ON
FACE 00335 06429173 29935097 AB 12.00 64.00 85.33 02/18/06 C01 4 CQJM7
408 DELAMINATION/LOOSE EXCA 06323583 29913828 AB 12.00 136.00 181.33 02/17/06 C01 4 CQBM5
408 DELAMINATION/LOOSE EXCA 06323583 29925410 AB 12.00 32.00 42.66 02/17/06 C01 4 CQJH1
408 DELAMINATION/LOOSE EXCA 06323583 29920591 AB 12.00 95.00 126.66 02/17/06 C01 4 SRMIKEJ
408 DELAMINATION/LOOSE P2805 06416362 29931181 AB 12.00 62.07 83.44 02/22/06 C01 3 SRLS6
408 DELAMINATION/LOOSE ULTI 06419099 29913583 AB 12.00 146.00 194.66 02/17/06 C01 4 CQVMIREL
408 DELAMINATION/LOOSE ULTI 06419099 29923162 AB 12.00 11.00 14.66 02/17/06 C01 4 CQVMIREL
408 DELAMINATION/LOOSE ULTI 06419099 29924968 AB 12.00 146.00 194.66 02/17/06 C01 4 CQSM1
408 DELAMINATION/LOOSE 00180 06409026 29928107 HP 12.00 17.04 23.11 02/22/06 C01 3 SRMARTHAR
408 DELAMINATION/LOOSE 00335 06429175 29915441 AB 12.00 214.05 285.88 02/18/06 C01 4 CQVMIREL
408 DELAMINATION/LOOSE 01024 06415794 29868338 AB 12.00 26.00 34.66 02/06/06 C01 2 SRRQUINT
408 DELAMINATION/LOOSE 01064 06404892 29910673 AB 12.00 100.02 133.55 02/16/06 C01 2 SRRQUINT
429 SHREDDED
EDGES KICO 06409966 29895852 AB 12.00 13.00 17.33 2/14/2006 C01 3 CQBM5
443 DELAM (LOOSE
EDGES) 00181 06427218 29922928 AB 12.00 18.06 24.66 2/20/2006 C01 1 CQCM5
443 DELAM (LOOSE
EDGES) 01032 06421469 29929139 AB 12.00 15.06 20.66 2/12/2006 C01 2 CQAPLEMO
443 DELAM (LOOSE
EDGES) 01566 06385599 29818659 AB 12.00 11.00 14.66 1/23/2006 C01 2 CQAPLEMO
400 LATEX ON
FACE 02303 06379952 29836265 LB 12.00 11.00 14.66 1/27/2006 C03 1 SRAC5
402 PULLED
ENDS 50197 06434108 29921757 AB 15.00 13.03 22.08 2/20/2006 C03 2 SRTWESS
403 HOLES 50197 06419942 29921445 AB 15.00 9.00 15.00 2/9/2006 C03 3 SRGF1
408 DELAMINATION/LOOSE PC826 06363087 29688456 AB 12.00 16.00 21.33 12/4/2005 C03 1 CQVMIREL
408 DELAMINATION/LOOSE RRTRE 06423032 29915215 AB 15.00 12.09 21.25 2/18/2006 C03 3 SRMROBER
408 DELAMINATION/LOOSE TREA 06421494 29914964 AB 15.00 23.00 38.33 2/18/2006 C03 3 SRMROBER
408 DELAMINATION/LOOSE 00186 03409907 28591562 AB 12.00 13.11 18.55 1/15/2005 C03 1 CQAPLEMO
408 DELAMINATION/LOOSE 01064 06413144 29927958 AB 12.00 47.05 63.22 2/22/2006 C03 3 CQAPLEMO
408 DELAMINATION/LOOSE 01093 06417177 29933542 LB 12.00 11.00 14.66 2/23/2006 C03 4 SRJHUTCH
408 DELAMINATION/LOOSE 04738 06420123 29887839 AB 15.00 12.03 20.41 2/10/2006 C03 2 SRGG8
408 DELAMINATION/LOOSE 50197 06419924 29881766 AB 15.00 60.06 100.83 2/9/2006 C03 3 SRRQUINT
408 DELAMINATION/LOOSE 80030 06415305 29899596 AB 12.00 15.04 20.44 2/14/2006 C03 4 SRMROBER

The code only picks up the codes that are not already in the
destination sheet Maybe we should filter on the Fin Roll column Because
there can be multiple codes but only one Fin Roll per code

Thanks A lot man you are on the right track with this I think
Charles

 

[mrdata]

Hi Ron I changed the code to filter on column E:E
And it seems to be working I have yet to try this in the real workbook
but I
am excited that this is going to do the trick I may need you to help
fine tune it.

When it brings the new data in and places it at the bottom I need to
Sort rows A5:M350 by column A
What code can I add that will do this?

I'm telling you I think my 3 month search for a solution to this is
almost over.
Your the greatest.

Thanks
Charles

 

[Ron de Bruin]

Hi mrdata

Sort rows A5:M350 by column A

Record a macro when you do this and you have the code

You seen something like this

Sheets("destination").Range("A1:M350").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

 

[mrdata]

Sub Lastweek()
Dim cell As Range
On Error Resume Next
For Each cell In
Sheets("L").Range("E:E").SpecialCells(xlCellTypeConstants)
If Application.WorksheetFunction.CountIf(Sheets("Last
Week").Range("E:E"), cell.Value) > 0 Then
'do nothing
Else
Worksheets("L").Range("A2:M350").Copy <<<<My attempt to edit the code
Worksheets("Last
Week").Range("A5:M350").PasteSpecialPaste:=xlPasteValues <<<My attempt
to edit the code Does not work
'Sheets("L").Rows(cell.Row).Copy Sheets("Last
Week").Cells(LastRow(Sheets("Last Week")) + 1, 1)

Sheets("Last Week").Range("A5350").Sort Key1:=Range("A4"),
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

End If
Next cell
End Sub

The rest of the code works except I only need the contents of Columns A
thru M copied not the entire row.
Thanks
Charles