Adding new data to an Excel list

[Cesar31]

Hello,

I'm struggling with a VBA code to add information from a new list to an existing one.

As you can see, I have a data table on the sheet named "Allocation".

I have classified my information by last name, country, and type. Then I have attributed some values by year :

On the sheet "2022", I have a different table with new information that I need to add to my existing one :

What I need to do is to add a new column at the right side of the table with the information of column G "Allocated" but respecting the criteria "Last name/Country/Type".

Then, add the not existing values in new rows and fill the empty cells with zero "0".

Could somebody please help me?
I need to do this for several years and hundreds of new data so it will be really helpful

Thanks

 

[mumps]

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your two sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[Cesar31]

Hello,

I'm struggling with a VBA code to add information from a new list to an existing one.

As you can see, I have a data table on the sheet named "Allocation".

I have classified my information by last name, country, and type. Then I have attributed some values by year :

View attachment 84826

On the sheet "2022", I have a different table with new information that I need to add to my existing one :

View attachment 84818

What I need to do is to add a new column at the right side of the table with the information of column G "Allocated" but respecting the criteria "Last name/Country/Type".

Then, add the not existing values in new rows and fill the empty cells with zero "0".

View attachment 84824

Could somebody please help me?
I need to do this for several years and hundreds of new data so it will be really helpful

Thanks

Hello,

I'm struggling with a VBA code to add information from a new list to an existing one.

As you can see, I have a data table on the sheet named "Allocation".

I have classified my information by last name, country, and type. Then I have attributed some values by year :

View attachment 84826

On the sheet "2022", I have a different table with new information that I need to add to my existing one :

View attachment 84818

What I need to do is to add a new column at the right side of the table with the information of column G "Allocated" but respecting the criteria "Last name/Country/Type".

Then, add the not existing values in new rows and fill the empty cells with zero "0".

View attachment 84824

Could somebody please help me?
I need to do this for several years and hundreds of new data so it will be really helpful

Thanks

I

It is hard to work with pictures. It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your two sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

I uploaded a copy of the file to dropbox.

Excel table.xlsm

Shared with Dropbox

www.dropbox.com

 

[mumps]

Try:

Sub CompareData()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, desWS As Worksheet
    Dim v1 As Variant, v2 As Variant, dic As Object, Val1 As String, Val2 As String, lCol As Long
    Set srcWS = Sheets("2022")
    Set desWS = Sheets("Allocation")
    v1 = srcWS.Range("C2", srcWS.Range("C" & Rows.Count).End(xlUp)).Resize(, 5).Value
    With desWS
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        .Cells(1, lCol) = srcWS.Name
        v2 = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v2) To UBound(v2)
        Val1 = v2(i, 1) & "|" & v2(i, 2) & "|" & v2(i, 3)
        If Not dic.exists(Val1) Then
            dic.Add Val1, i + 1
        End If
    Next i
    For i = LBound(v1) To UBound(v1)
        Val2 = v1(i, 1) & "|" & v1(i, 2) & "|" & v1(i, 3)
        If dic.exists(Val2) Then
            desWS.Cells(dic(Val2), lCol) = v1(i, 5)
        Else
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = Array(v1(i, 1), v1(i, 2), v1(i, 3))
                .Cells(.Rows.Count, "D").End(xlUp).Offset(1).Resize(, lCol - 4) = 0
                .Cells(.Rows.Count, lCol).End(xlUp).Offset(1) = v1(i, 5)
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Cesar31]

Try:

Sub CompareData()
    Application.ScreenUpdating = False
    Dim i As Long, srcWS As Worksheet, desWS As Worksheet
    Dim v1 As Variant, v2 As Variant, dic As Object, Val1 As String, Val2 As String, lCol As Long
    Set srcWS = Sheets("2022")
    Set desWS = Sheets("Allocation")
    v1 = srcWS.Range("C2", srcWS.Range("C" & Rows.Count).End(xlUp)).Resize(, 5).Value
    With desWS
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        .Cells(1, lCol) = srcWS.Name
        v2 = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 3).Value
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v2) To UBound(v2)
        Val1 = v2(i, 1) & "|" & v2(i, 2) & "|" & v2(i, 3)
        If Not dic.exists(Val1) Then
            dic.Add Val1, i + 1
        End If
    Next i
    For i = LBound(v1) To UBound(v1)
        Val2 = v1(i, 1) & "|" & v1(i, 2) & "|" & v1(i, 3)
        If dic.exists(Val2) Then
            desWS.Cells(dic(Val2), lCol) = v1(i, 5)
        Else
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = Array(v1(i, 1), v1(i, 2), v1(i, 3))
                .Cells(.Rows.Count, "D").End(xlUp).Offset(1).Resize(, lCol - 4) = 0
                .Cells(.Rows.Count, lCol).End(xlUp).Offset(1) = v1(i, 5)
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Thank you so much. It is perfect !!!

 

[mumps]

You are very welcome.