Copying unique rows to another sheet

[lanhao]

Hi there,

Been a while since i have been here to bring up a quandry... but it had to happen at some point :)

Nutshell sum up, I'm trying to streamline some code where it will check a row of data on one page, and another page to see if it already has that data. If it doesn't, it's supposed to go through and copy the row to the respective workbook.

I have a feeling I am missing something incredibly simple, but again, extra eyes never hurts.

Thanks for the help in advance


Dim i As Integer
Dim k As Integer
Dim v As Integer
Dim qc As Integer
Dim Chk As Long
Dim eRow As Long
Dim sht2 As Worksheet
Application.ScreenUpdating = False
k = 2
With sht1
For v = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 1
If .Cells(k, "H") = "Darla" Then Set sht2 = Worksheets("Darla")
If .Cells(k, "H") = "Chris" Then Set sht2 = Worksheets("Chris")
If .Cells(k, "H") = "Jim" Then Set sht2 = Worksheets("Jim")
If .Cells(k, "H") = "Kris" Then Set sht2 = Worksheets("Kris")
If .Cells(k, "H") = "Glenn" Then Set sht2 = Worksheets("Glenn")
If .Cells(k, "H") = "Jen" Then Set sht2 = Worksheets("Jen")
eRow = sht2.Cells(Rows.Count, "A").End(xlUp).Row
If sht1.Range("A" & k) <> sht2.Range("A" & v) Then
sht1.Rows(k).Copy Destination:=Worksheets(sht2).Rows(eRow)
End If
k = k + 1
Next
End With
Application.ScreenUpdating = True


Thanks again for everything and look forward to the response soon.

[mdmackillop]

Untested but try


k = 2
With sht1
For v = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 1
Set sht2 = Worksheets(sht1.Cells(k, "H"))
eRow = sht2.Cells(Rows.Count, "A").End(xlUp).Row
If sht1.Range("A" & k) <> sht2.Range("A" & v) Then
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
End If
k = k + 1
Next
End With

[lanhao]

That's a heck of alot cleaner than what I was cobbling together... It's just giving an error msg about a type mismatch for the Set sht2 line.

This is impressive, and congrats on the promotion btw. :)

[mdmackillop]

I think we need an extra step in there.


With Sht1
For v = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 1
Dim shName As String
shName = Sht1.Cells(k, "H")
Set sht2 = Sheets(shName)
eRow = sht2.Cells(Rows.Count, "A").End(xlUp).Row
If Sht1.Range("A" & k) <> sht2.Range("A" & v) Then
Sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
End If
k = k + 1
Next
End With

[lanhao]

Well, I was trying that at my end too, but i keep on getting a runtime error at my end on this one. For some reason it's not looking at shName as a workbook name... the runtime error I've been pulling up is a '9 - Subscript out of range' message.

Should one of the variables be changed to a range instead possibly?

[mdmackillop]

There's no reference in your code to workbook names, so I assumed this was all in one workbook.
There will be an error if there is no sheet name with the value in cell (k,"H")

[lanhao]

This is in all one workbook, just on different sheets. That's the part that's really odd about this. every row in column H does have something, i double checked it. sht1 is set to the worksheet that all the data is being pulled from...

I'm tried changing v to 2 instead of 1, but that doesn't do anything either...

[mdmackillop]

Can you sanitise and post a copy of your workbook?

[lanhao]

the problem is that i work in a place that's got too much proprietary information...

I am however going to repost the entire code that I have thus far just in case i forgot to post it earlier and it was something of an oversight on my part.


Sub Datamove()
' Datamove Macro
' Macro recorded 10/13/2006 by Andy Lewis
'Baseline variable list
Set sht1 = Worksheets("Uncorrected QC")
'Counters for respective worksheet pages
Dim i As Integer
Dim k As Integer
Dim v As Integer
Dim eRow As Long
Dim sht2 As Worksheet
Application.ScreenUpdating = False
k = 2
With sht1
For v = 2 To .Cells(Rows.Count, "A").End(xlUp).Row 'Step 1
Dim shName As String
shName = sht1.Cells(k, "H")
Set sht2 = Sheets(shName)
eRow = sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
If sht1.Range("B" & k) <> sht2.Range("B" & v) And sht1.Range("C" & k) <> sht2.Range("C" & v) Then
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
End If
k = k + 1
Next
End With
Application.ScreenUpdating = True
End Sub


This is everything that I have as of right now. I can try to put something together, but unfortunately it is not going to have any information in it, unless i just put together dummy data

[mdmackillop]

A small amount of dummy data will suffice. It's mainly the Sheet Names etc. layout that seems critical

[lanhao]

ok - here's what i can put together on this stuff then

Just made 40 rows of fabricated information, not every column is filled in, but the ones i care about are A B and C really for the sort criteria, maybe col F as well, but i can always modify that later.

Hope it helps.

[Charlize]

It works for me ? Data is copied to the sheets concerned. What's with the tab corrected items ?

Charlize

[lanhao]

that's the sheet where they get moved to once they are corrected (that's a separate macro which i have done already).

For some reason i get a runtime error with the code as it stands right now, and I am not understanding why it is doing it... did you do any tpype of variant with the code by chance?

[lanhao]

ok, actually i found the problem with the main data... it had a few discrepancies which did not match to the original names for the worksheet tabs ^^;

it had to be something that small... (for the record, the person who was handling the information prior to me put a few spaces in after some of the names on some cells.) :banghead:

I'll mark this as solved and then apply a brick to the back of the head of the person who did this...

Thank you again all for the help on this. :D

[Charlize]

You could set the line
option compare text above the Sub Datamove(). I think it ignores capital letter and spaces. Maybe the line
on error resume next to skip errors and to go to the next datarow ? Maybe restricted input to some values ?

Charlize