PDA

View Full Version : Solved: Copy unique values only once



lanhao
10-18-2006, 02:02 PM
This is actually in reference to the second to last post I put up.

http://www.vbaexpress.com/forum/showthread.php?t=9859

Basically it is copying over the values, however, even after it's copied once, and i hit the copy button again so it would copy the new entries over, it grabs the old ones as well and brings them over.

Any suggestions on why it's not doing what it's supposed to do?

Sub Datamove()
'
' Datamove Macro
' Macro recorded 10/13/2006 by Andy Lewis
'
'Baseline variable list

'Counters for respective worksheet pages
Dim i As Integer
Dim k As Integer
Dim v As Integer
Dim eRow As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set sht1 = Worksheets("Uncorrected QC")

Application.ScreenUpdating = False
k = 2
With sht1
For v = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 1
Dim shName As String
shName = sht1.Range("H" & k)
eRow = Sheets(shName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
If sht1.Range("B" & k) <> Sheets(shName).Range("B" & v) And sht1.Range("D" & k) _
<> Sheets(shName).Range("D" & v) _
And sht1.Range("A" & k) <> Sheets(shName).Range("A" & v) And sht1.Range("F" & k) _
<> Sheets(shName).Range("F" & v) Then
sht1.Rows(k).Copy Destination:=Sheets(shName).Rows(eRow)
End If
k = k + 1
Next
End With
Application.ScreenUpdating = True
End Sub

Thanks muchly in advance for any help/suggestions that might be able to be given. :)

edited by Lucas: line breaks added to code

lucas
10-18-2006, 02:24 PM
How hard would it be to post the workbook so we don't have to duplicate your work..?

lanhao
10-18-2006, 02:35 PM
can use the testrun book i made with dummy data earlier, it does the same thing by copying the same info over if you click the button again.

I'll upload it here so you can see what it looks like.

I just need for it to somehow realize it copied the info over already so it doesn't create redundancies.

mdmackillop
10-19-2006, 01:05 PM
Avoiding duplicates has cropped up in a few queries recently. If your data has a a unique value in each row, you can check for this before copying. Otherwise, the simplest thing is to add a Recording column to which say "x" is added when the data is copied. But then, do you ever edit your source, after it is copied, because then the Recording column needs to be cleared, and the code modified to overwrite the previous entry.

lanhao
10-19-2006, 03:29 PM
ok - so how would i get this code to where it will check the entirety of the page where it is going to copy to?

mdmackillop
10-19-2006, 03:41 PM
Assuming Column 2 contains unique value, something like

Dim c As Range
Set c = sht2.Columns(2).Find(.Cells(k, 2))
If c Is Nothing Then
Set c = Nothing
MsgBox "Doing Copy"
'your copy code
Else
MsgBox "Exists"
'Do nothing
End If

lanhao
10-20-2006, 11:58 AM
it actually is not unique values, they're account numbers and there is a chance that someone has called in befor regarding an issue... so would i code it where it has to match multiple pieces of information then, and if it doesn't, set it to nothing?

mdmackillop
10-20-2006, 01:43 PM
It's not so easy to search multiple cells. You could concatenate multiple values into a temporary location and check against that. It all depends on your data and your usage which is easiest.

lanhao
10-20-2006, 02:40 PM
hrm, i just realized something that is going to make my life a bit more interesting on this. Some of the information in the primary column might crop up more than one time (it's an account number basically), and there is a possibility that someone else might enter in an order for the same account. any suggestions on getting the code tweaked for it?

lanhao
10-25-2006, 02:44 PM
I figured I would mark it as solved, since i did get something to work. I am including the code, since this was an odd one - well for me at any rate.

Thank you all for your help :)

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 'Row counter for sht1
Dim v As Integer
Dim tick As Long 'Counter for records copied
Dim eRow As Long 'Last row on sht2
Dim sht2 As Worksheet 'worksheet that will change name depending on a value
Dim Tac As String, Trep As String, Tindt As String 'values based on the find function
Application.ScreenUpdating = False
k = 2
v = 2
tick = 0
With sht1
For v = 2 To sht1.Cells(Rows.Count, "A").End(xlUp).Row 'Goes through each row on sht1
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
Dim c As Range
Set c = sht2.Columns(2).Find(sht1.Cells(k, "B").Value)
If c Is Nothing Then 'If it finds no match, it copies the row from sht1 to the respective sheet
Set c = Nothing
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1
Else 'If it does find a match value wise, it compares those two cells as well to see if they match
'MsgBox "Already Exists"
Tac = c.Address
Trep = c.Offset(0, 2).Value
Tindt = c.Offset(0, 3).Value
If Trep <> sht1.Cells(k, "D").Value Or Tindt <> sht1.Cells(k, "E").Value Then
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1
'If it finds that either of the two variables don't match - it will copy the row over
End If
'v = v + 1
'Does nothing else
End If
k = k + 1
Next v
MsgBox "Records copied: " & tick
End With
Application.ScreenUpdating = True
End Sub