Consulting

Results 1 to 10 of 10

Thread: Solved: Copy unique values only once

  1. #1

    Solved: Copy unique values only once

    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?

    [VBA]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[/VBA]

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

    edited by Lucas: line breaks added to code
    Heaven won't take me.. Hell is afraid I'll take over... adn Purgatory doesn't have a smoking section... I am SO screwed...

  2. #2
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    How hard would it be to post the workbook so we don't have to duplicate your work..?
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  3. #3
    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.
    Heaven won't take me.. Hell is afraid I'll take over... adn Purgatory doesn't have a smoking section... I am SO screwed...

  4. #4
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    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.
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  5. #5
    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?
    Heaven won't take me.. Hell is afraid I'll take over... adn Purgatory doesn't have a smoking section... I am SO screwed...

  6. #6
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Assuming Column 2 contains unique value, something like
    [VBA]
    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
    [/VBA]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  7. #7
    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?
    Heaven won't take me.. Hell is afraid I'll take over... adn Purgatory doesn't have a smoking section... I am SO screwed...

  8. #8
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    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.
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  9. #9
    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?
    Heaven won't take me.. Hell is afraid I'll take over... adn Purgatory doesn't have a smoking section... I am SO screwed...

  10. #10
    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

    [VBA]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
    [/VBA]
    Heaven won't take me.. Hell is afraid I'll take over... adn Purgatory doesn't have a smoking section... I am SO screwed...

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •