Copying the first instance of the a which occurs 'n' no.of times to a new workbook

Question

first of all thank you so much for bringing up such a site which is very helpful for people like me, who are starting to work with VBA. I am in the process of trying to automate a manual work that i do, which is really a time consuming one. Pls help me on this. The req. is as below:

X       Y
----    ---
2134    100
2134    200
2134    300
3456    400
3241    500
2516    600
2516    700

I have a sheet with 'X' and 'Y' column as above. This is my source sheet, i have thousands of values like this and the rows gets added up daily(dynamic). I want the output sheet in a new workbook>>new sheet and it should have the output as below:

X1      Y1
----    ---
2134    100
3456    400
3241    500
2516    600

i.e., the first instance of column 'X' and 'Y'. Please help me to get a VBA to do this automatically. I am spending 4 hours for this work daily as i need to manually update for 1000s of data.

THANKS in ADVANCE

Answer 1

Sub Firsts()
    Dim dict As Object, k
    Dim c As Range, tmp
    Dim sht As Worksheet

    Set dict = CreateObject("scripting.dictionary")

    For Each c In ActiveSheet.Range("A1:A10000").Cells
        tmp = c.Value
        If Len(tmp) = 0 Then Exit For
        If Not dict.exists(tmp) Then dict.Add tmp, c.Offset(0, 1).Value
    Next c

    DumpDict Workbooks.Add().Sheets(1).Range("A1"), dict

End Sub


Sub DumpDict(rng As Range, dict As Object)
Dim k, r As Long
    r = 0
    For Each k In dict.keys
        rng.Cells(1).Offset(r, 0).Resize(1, 2).Value = Array(k, dict(k))
        r = r + 1
    Next
End Sub

Answer 2

Another option is to choose Advanced Filter from the Data Tab with the options below.

Now you can copy and paste the results to a new sheet and clear the filter

Answer 3

I believe this will get you what you want:

Sub copyOver()
    Dim count As Integer
    count = Application.WorksheetFunction.CountA(Range("A:A"))
    Dim rowCount As Integer
    rowCount = 1
    Dim i As Integer
    i = 2
    Do While i <= count
        Dim str As String
        str = Range("A" & i)
        Dim find As String
        On Error GoTo copy:
        find = Application.WorksheetFunction.VLookup(str, Range("A1:A" & (i - 1)), 1, False)
        i = i + 1
    Loop
    Exit Sub
copy:
    If (Range("A" & i) = "") Then
        Resume Next
    End If
    Call copier(Range("A" & i), Range("B" & i), rowCount)
    rowCount = rowCount + 1
    Resume Next
End Sub

Sub copier(str1 As String, str2 As String, rowCount As Integer)
    Worksheets("Sheet2").Range("A" & rowCount) = str1
    Worksheets("Sheet2").Range("B" & rowCount) = str2
End Sub

Just make sure your data are in columns A and B and start below row 1. Hope this helps!