VBA Append if it does not exist

[gerald24]

Hi Guys,

Need help with the below. I want to append my initial list from "Final" Sheet but if the same details already exist, I want it to just move to the next.
So it is like, I have a concatenate of Class, Name and Age in one sheet, and I have the same concatenate to another sheet.

My code is really messy, TIA!!!

Sub Append()

Dim LastRow As Integer
Dim LastRow2 As Integer
Dim Class, Name, Age, Multirange As Range
Dim Class2, Name2, Age2, Multirange2 As Range
Dim CL As Range
Dim Rng As Range

Sheets("Sheet1").Select

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Set Class = Range("B2:B" & LastRow)
Set Name = Range("D2:D" & LastRow)
Set Age = Range("F2:F" & LastRow)
Set Multirange = Union(Fund, TID, Forward_Date)

Set Class2 = Sheets("Computation").Range("A2:A" & LastRow)
Set Name2 = Sheets("Computation").Range("B2:B" & LastRow)
Set Age2 = Sheets("Computation").Range("C2:C" & LastRow)
Set Multirange2 = Union(Fund, TID, Forward_Date)


   For Each CL In Multirange
            If Not CL.Value = Multirange2 Then
                If Rng Is Nothing Then
                    Set Rng = CL
                Else
                    Set Rng = Union(Rng, CL)
                End If
            End If
    Next CL
            If Not Rng Is Nothing Then Rng.Copy
            Sheets("Final").Select
            Range("A" & Rows.Count).Select
            ActiveCell.End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues




End Sub

 

[StephenCrump]

thought that it did not work ...

I have added a MessageBox to confirm:

Sub Append()

    Dim FirstRow As Long, LastRow As Long, lCount As Long, i As Long
    Dim rng As Range
    Dim vIn As Variant, vOut() As Variant

    FirstRow = 2
    
    'Assumes Class, Name, Age in cols B,D,F of "Final", and A,B,C of "Computation"
    With Worksheets("Final")
        'Read Class, Name and Age into a variant array
        'We've loaded five columns in one statement to make it quick,
        'even though we only really need columns 1, 3 and 5 (i.e. B, D and F)
        vIn = .Range("B" & FirstRow & ":F" & .Cells(Rows.Count, 2).End(xlUp).Row).Value2
    End With
    With Worksheets("Computation")
        Set rng = .Range("A" & FirstRow & ":C" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    'Make an array vOut, with 3 columns and the same number of rows as vIn
    'This is the [U]maximum[/U] size we can possibly need.  We probably won't fill this array.
    ReDim vOut(1 To UBound(vIn), 1 To 3)

    For i = 1 To UBound(vIn)
        'Standard Excel Countif() function
        If Application.CountIfs(rng.Columns(1), vIn(i, 1), rng.Columns(2), vIn(i, 3), rng.Columns(3), vIn(i, 5)) = 0 Then
            'Unique details - populate a new line in our array vOut
            lCount = lCount + 1
            vOut(lCount, 1) = vIn(i, 1)
            vOut(lCount, 2) = vIn(i, 3)
            vOut(lCount, 3) = vIn(i, 5)
        End If
    Next i
    
    If lCount > 0 Then
        'Create a range (with lCount rows and 3 columns) at the end of our existing rng
        'Populate it with the contents of vOut
        'vOut will probably contain blank rows after the lCount'th row, but these won't fit into the range created,
        rng.Offset(rng.Rows.Count).Resize(lCount, 3).Value = vOut
        MsgBox lCount & " unique rows added!"
    Else
        MsgBox "No uniques found!"
    End If
    
End Sub

 

[gerald24]

Could you teach me what did you do here? I tried to search google but couldn't understand the function.

I have added a MessageBox to confirm:

Sub Append()

    Dim FirstRow As Long, LastRow As Long, lCount As Long, i As Long
    Dim rng As Range
    Dim vIn As Variant, vOut() As Variant

    FirstRow = 2
    
    'Assumes Class, Name, Age in cols B,D,F of "Final", and A,B,C of "Computation"
    With Worksheets("Final")
        'Read Class, Name and Age into a variant array
        'We've loaded five columns in one statement to make it quick,
        'even though we only really need columns 1, 3 and 5 (i.e. B, D and F)
        vIn = .Range("B" & FirstRow & ":F" & .Cells(Rows.Count, 2).End(xlUp).Row).Value2
    End With
    With Worksheets("Computation")
        Set rng = .Range("A" & FirstRow & ":C" & .Cells(Rows.Count, 1).End(xlUp).Row)
    End With
    'Make an array vOut, with 3 columns and the same number of rows as vIn
    'This is the [U]maximum[/U] size we can possibly need.  We probably won't fill this array.
    ReDim vOut(1 To UBound(vIn), 1 To 3)

    For i = 1 To UBound(vIn)
        'Standard Excel Countif() function
        If Application.CountIfs(rng.Columns(1), vIn(i, 1), rng.Columns(2), vIn(i, 3), rng.Columns(3), vIn(i, 5)) = 0 Then
            'Unique details - populate a new line in our array vOut
            lCount = lCount + 1
            vOut(lCount, 1) = vIn(i, 1)
            vOut(lCount, 2) = vIn(i, 3)
            vOut(lCount, 3) = vIn(i, 5)
        End If
    Next i
    
    If lCount > 0 Then
        'Create a range (with lCount rows and 3 columns) at the end of our existing rng
        'Populate it with the contents of vOut
        'vOut will probably contain blank rows after the lCount'th row, but these won't fit into the range created,
        rng.Offset(rng.Rows.Count).Resize(lCount, 3).Value = vOut
        MsgBox lCount & " unique rows added!"
    Else
        MsgBox "No uniques found!"
    End If
    
End Sub

 

[StephenCrump]

I tried to search google but couldn't understand the function.

Which part of the code are you not understanding?

 

[gerald24]

Which part of the code are you not understanding?

Hey sorry, I missed that you wrote notes to the code. digesting it now.

I realized that when one column is missing, it does not consider it as unique and continuously append if I run the codes multiple times.

 

[StephenCrump]

I realized that when one column is missing, it does not consider it as unique and continuously append if I run the codes multiple times.

When you say one column is missing, I assume you mean that in some row(s), a field or fields might be blank? Can you give an example to illustrate what you want to do here, e.g. should we ignore these rows, or still check if they are "unique" (albeit with blank fields).

Note also that my code above doesn't allow for duplicates in the "Final" Sheet. If you have two (or more) identical records, the code will copy them twice (or more) to the "Computation" sheet if they don't already exist there. Is this OK, or do we need to allow for the possibility of duplicates in "Final"?

 

[gerald24]

When you say one column is missing, I assume you mean that in some row(s), a field or fields might be blank? Can you give an example to illustrate what you want to do here, e.g. should we ignore these rows, or still check if they are "unique" (albeit with blank fields).

For Example:

Let's Say in "Computation Tab" I Have


Class Name Age
History Mark 16

In the "Finals Tab" I have

Class Name Age
History Mark (Blank)

I still want History-Mark-(Blank) to be considered a "Unique".

Based on the records that I have, I can say that only the Age Column has the possibility to have "blank"

Note also that my code above doesn't allow for duplicates in the "Final" Sheet. If you have two (or more) identical records, the code will copy them twice (or more) to the "Computation" sheet if they don't already exist there. Is this OK, or do we need to allow for the possibility of duplicates in "Final"?

Right, it is possible for my records to have duplicate copies in the "Final". But I think I need them to not be copied twice in the "Computation"


Thank you sooooo much!