0

Basically I am new to doing any kind of coding and I can input written codes and figure out what I need to change but i am pants at writing anything new.

I have an excel spreadsheet that we keep track of acceptance into a program and rejections. I need to keep track of the rejections on a second sheet so they are all in one area.

I found a VBA code for Excel that successfully copies information I want from one sheet based on value to a second sheet. So when I select "rejected" and run the code, it copies all the data over to the second sheet. It works great with one caveat, every time I run the code it pulls new data and previously copied data.

I would like to add to the VBA code to either not copy data previously copied or find a code that auto deletes the duplicates.

So I did look around to see if I could find some de-dup VBA codes and I tried a few but the original code didn't play well and I got some errors. I had one that looked really good but it doesn't seem to play well with the original copy code.

Below is the current code that is working to copy the rejected. 

Private Sub CommandButton1_Click()

a = Worksheets("ARD2019").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a
If Worksheets("ARD2019").Cells(i, 2).Value = "Rejected" Then
    Worksheets("ARD2019").Rows(i).Copy
    Worksheets("Rejected").Activate
    b = Worksheets("Rejected").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Rejected").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("ARD2019").Activate

End If
Next

Application.CutCopyMode = False

My hope here is that I don't have to tell the people using the program to just manually run Excel's deduping function but if it isn't realistic to write a code ontop of the code above, i don't think they will complain since this is still better than what they were doing previously which was manually coping rows over.

Sebastian Pakieła
  • 2,970
  • 1
  • 16
  • 24
Caffeinated Frenzy
  • 1
  • https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – Tim Stack Apr 09 '19 at 12:53
  • Go to Developer->record macro->start recording->go to the output sheet and use under the ribbon Data the feature to remove duplicates, check the code and add it to your current code. – Damian Apr 09 '19 at 13:00
  • Instead of the copy/paste method, you can have the VBA code move only the data rows that are not duplicates. It means you'll have to create a `Dictionary` of your current data and then compare each row of your "new" data to figure out which rows are new and which are duplicates (and skip those). [This link](https://stackoverflow.com/a/55418615/4717755) might help give you a start. – PeterT Apr 09 '19 at 13:05
  • Or if you don't think you can figure that out just copy the rows and remove duplicates after with `Range.RemoveDuplicates` – urdearboy Apr 09 '19 at 13:13
  • Is there any unique key for each line? is there a chance to change cell value for old records? – Error 1004 Apr 09 '19 at 13:14
  • Thanks for all the responses. I'll take a look at all the options you've given me and give them each a go. Error 1004, there is a unique key for each line. I could possibly look at making a second value like "Reject Filed" for after they have been recorded so that it doesn't grab them next time the process is run. I'll also look at a possible Dictionary option and the removal of duplicates through Developer. – Caffeinated Frenzy Apr 09 '19 at 13:20

1 Answers1

0

Let us assume that Column A has unique keys in both sheets. Below is a simple way to get start:

Option Explicit

Private Sub CommandButton1_Click()

    Dim LastRowSour As Long, LastRowDest As Long, Row As Long
    Dim wsSou As Worksheet, wsDes As Worksheet

    'Set worksheets
    With ThisWorkbook
        Set wsSou = .Worksheets("ARD2019")
        Set wsDes = .Worksheets("Rejected")
    End With

    'Find the last row of column A of wsSou
    LastRowSour = wsSou.Cells(wsSou.Rows.Count, "A").End(xlUp).Row

    'Loop start from row 2 to LastRowSour
    For Row = 2 To LastRowSour

        'Find the last row of column A of wsDes
        LastRowDest = wsDes.Cells(wsDes.Rows.Count, "A").End(xlUp).Row

        'Chek if .Cells(Row, 2).Value is reject & wsSou.Cells(Row, 1).Value is not appear in the first column of wsDes
        If wsSou.Cells(Row, 2).Value = "Rejected" And Application.CountIf(wsDes.Range(wsDes.Cells(1, 1), wsDes.Cells(LastRowDest, 1)), wsSou.Cells(Row, 1).Value) = 0 Then

            wsSou.Rows(Row).Copy

            wsDes.Range("A" & LastRowDest + 1).PasteSpecial xlPasteValues

        End If

    Next

    Application.CutCopyMode = False

End Sub
Error 1004
  • 7,877
  • 3
  • 23
  • 46
  • That worked so perfectly it hurts. Thank you so much for writing this out for me. That is just amazing to me. I'll have to look into VBA coding training and websites that teach it so I can do stuff like this. – Caffeinated Frenzy Apr 09 '19 at 13:36
  • glad to hear that i help. you can also find out more faster solutions. if this solution satisfy your needs just vote it as the answer of this question. – Error 1004 Apr 09 '19 at 13:43
  • 1
    I tried, it told me that due to the fact i'm new, it is recorded but won't show up. Thanks again. – Caffeinated Frenzy Apr 09 '19 at 13:49