Add new data if not in current list using VBA

[kentster]

Hi

I am using Excel 2013 and I currently run a macro that gives me a NEW list of data which I could compare to the prior list. I am hoping to that via VBA code within the current macro I have set up. I want to compare a piece of data to the see if it matches the existing set of data (e.g. John Taylor = John Taylor). If there is a match, just add the associated data to the existing name. If the name on the new pull is NOT in the existing list, then add the name to the existing list AND fill in the appropriate data. Example below:

Column A has the existing list of names
Column B has a % value tied to each name

Week 1 run

John 50%
Suzy 60%
Sally 70%

Week 2 run

John 60%
Suzy 35%
Steve 75%

What I would like to see as the end result on the existing list is this:

Master list

John 50% 60%
Suzy 60% 35%
Sally 70% 0% (because Sally was NOT found on the new list, she gets a 0% for the current week)
Steve 0% 75% (Steve is on the new list so his data for that week flows over to the existing list with the prior week being 0% because he wasn't on the list during the prior run)

I hope this makes sense. My head is spinning trying to find a way to use a helper tab with the names from existing and the new pull and trying vlookups, etc, but I just cannot get anything to work like the above.

Thanks
Kent

 

[Peter h]

If you don't get a reply to this by tomorrow, I'll try to help you out. I've got a project that has code that I think does something similar to what you're looking for.

 

[kentster]

UPDATED: After thinking about this, if I can get the names from the EXISTING list AND the names from the NEW list into one sheet without duplicates then from that MASTER list I can capture my values using a vlookup. I think this is the easiest route, maybe...

Thanks
Kent

 

[Peter h]

Here's a code that will do what you're wanting. This takes unique values from a list in Column A and starts a list of those unique items into Column C, then takes the data in Column B and matches them to the new list in Column C. If you notice any issues or need it to do anything different, just let me know. I put the code in a regular module, and had a button on the worksheet that would run the macro. Remember to change the sheet names, and ranges to fit your application.

Sub combData()
'Set a reference to the "Microsoft Scripting Runtime" library in the VBE
Dim ws As Worksheet
Dim LastRow As Long, i As Long, lCol As Long, lRow As Long
Dim uniRng As Range
Dim arr As Variant
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
Set ws = ThisWorkbook.Sheets("Sheet1")
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
arr = ws.Range("A1:A" & LastRow) 'Populates the array
For i = LBound(arr) To UBound(arr)
    dict(arr(i, 1)) = 1 'Populates the dictionary with unique values
Next i
For i = 0 To dict.Count - 1
    ws.Cells(i + 1, 3).Value = dict.Keys(i) 'Writes the dictionary to the worksheet
Next i
lRow = ws.Range("C" & Rows.Count).End(xlUp).Row
Set uniRng = ws.Range("C1:C" & lRow)
For Each Cell In uniRng
    For i = 1 To LastRow
        If ws.Cells(i, 1) = Cell Then
            lCol = ws.Cells(Cell.Row, Columns.Count).End(xlToLeft).Column
            ws.Cells(Cell.Row, lCol + 1) = ws.Cells(i, 2)    'Takes data from column B and matches it to the master list in C
        End If
    Next i
Next Cell
End Sub

The code above does what you were requesting, but out of boredom I wrote another code that does the same thing, but instead of making another list it takes the unique values and puts them across Row 1 in another sheet as headers, and then lists the corresponding data in the appropriate column. If you're interested in something like that, here is the code. If not, that's fine, I just did it out of boredom anyways. lol.

Sub makeHeaders()
'
'   Takes each unique item in list and creates Headers with those items, then lists each matching data under each appropriate header
'
Dim ws2, ws3 As Worksheet
Dim LastRow As Long, i As Long, lCol As Long, lRow As Long
Dim uniRng As Range
Dim arr As Variant
Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set ws3 = ThisWorkbook.Sheets("Sheet3")
LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1
arr = ws2.Range("A1:A" & LastRow) 'Populates the array
For i = LBound(arr) To UBound(arr)
    dict(arr(i, 1)) = 1 'Populates the dictionary with unique values
Next i
For i = 0 To dict.Count - 1
    ws3.Cells(1, i + 1).Value = dict.Keys(i) 'Writes the dictionary to the worksheet
Next i
lCol = ws3.Cells(1, Columns.Count).End(xlToLeft).Column
Set uniRng = ws3.Range("A1", ws3.Cells(1, lCol))

For Each Cell In uniRng
    For i = 1 To LastRow
        If ws2.Cells(i, 1) = Cell Then
            lRow = ws3.Cells(Rows.Count, Cell.Column).End(xlUp).Row
            ws3.Cells(lRow + 1, Cell.Column) = ws2.Cells(i, 2)    'Takes data from column B and matches it to the header in sheet3
        End If
    Next i
Next Cell
End Sub

 

[kentster]

Thanks so much! I will give it a try as soon as am done traveling!

 

[Peter h]

Thanks so much! I will give it a try as soon as am done traveling!

Keep me updated. Let me know if it works how you need it, or if we need to make changes.