Add value to a next cell if does not exist in the list yet

[Vokain]

Hi I have a long list of names in cells A1 to about A1000. Every week I get a new list which sometimes has some new names. Is there any way to add the new values to the end of the list?

something like. if b2:b2000 (the new list) <> in A1 to A1000 then add to next available cell in column A

Thank you!

 

[Vokain]

any ideas guys?

 

[Weaver]

Without using vb, you could use countif to count the number of occurences of each name in the new list against the old list. If you then filter the result for zero, all those that appear in the filter will be new names.

 

[Vokain]

I think I have something similar already but I was looking for something more automated....

 

[Rick Rothstein]

Give this macro a try...

Sub AddNewNamesToList()
  Dim X As Long, NextOldRow As Long, LastNewRow As Long
  NextOldRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
  LastNewRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  With Range("B1:B" & LastNewRow)
    .Copy Cells(NextOldRow, "A")
    Cells(NextOldRow, "B").Resize(LastNewRow).FormulaR1C1 = "=IF(COUNTIF(R1C1:R[-1]C1,RC1),""X"","""")"
    .Clear
  End With
  With Columns("B")
    .Value = .Value
    On Error Resume Next
    .SpecialCells(xlConstants).Offset(, -1).Delete xlShiftUp
    On Error GoTo 0
    .Clear
  End With
  Application.ScreenUpdating = True
End Sub

 

[Vokain]

Works! THANK YOU!

one more question. if the row B is in another sheet how would that look?

i.e column A in sheet1 column B in sheet2?

 

[Rick Rothstein]

one more question. if the row B is in another sheet how would that look?

i.e column A in sheet1 column B in sheet2?

I have generalized my code so that you can set the columns and worksheets that your data is on (Row 1 is always assumed to be the starting row for both lists though)... you would do that in the set-off section towards the top of the code. One note though... now that you move the "new names list" to another worksheet, you should know that my code assumes Column B on the "existing names list" is not being used as I write and then clear information in that column. I can generalize my code further, if you need that column for other data, but doing that will make the code even harder to read than it has become for the change you just requested, so I decided not to do it unless you tell me you need it.

Sub AddNewNamesToList()
  Dim X As Long, NextOldRow As Long, LastNewRow As Long, ColNum As Long, WS1 As Worksheet, WS2 As Worksheet
 
  Const ExistingNamesColumn As String = "A"
  Const NewNamesColumn As String = "B"
  Set WS1 = Worksheets("Sheet1")
  Set WS2 = Worksheets("Sheet2")
 
  ColNum = Columns(ExistingNamesColumn).Column
  NextOldRow = WS1.Cells(Rows.Count, ExistingNamesColumn).End(xlUp).Row + 1
  LastNewRow = WS2.Cells(Rows.Count, NewNamesColumn).End(xlUp).Row
  Application.ScreenUpdating = False
  With WS2.Range(NewNamesColumn & "1:" & NewNamesColumn & LastNewRow)
    .Copy WS1.Cells(NextOldRow, ExistingNamesColumn)
    WS1.Cells(NextOldRow, ExistingNamesColumn).Offset(, 1).Resize(LastNewRow).FormulaR1C1 = "=IF(COUNTIF(R1C" & ColNum & ":R[-1]C" & ColNum & ",RC1),""X"","""")"
  End With
  With WS1.Columns(ExistingNamesColumn).Offset(, 1)
    .Value = .Value
    On Error Resume Next
    .SpecialCells(xlConstants).Offset(, -1).Delete xlShiftUp
    On Error GoTo 0
    .Clear
  End With
  Application.ScreenUpdating = True
End Sub

 

[Darren Bartrup]

Couldn't you just add all the names at the bottom and click 'Remove Duplicates' on the Data ribbon? Providing you don't want duplicates that is.

 

[Rick Rothstein]

Couldn't you just add all the names at the bottom and click 'Remove Duplicates' on the Data ribbon?

You can do that only if you are using XL2007 or above.

So, if the OP is using XL2007 or above, and he still wants to use VBA to simplify the process, then my latest generalized code can be reduced to this...

Sub AddNewNamesToList()
  Dim X As Long, NextOldRow As Long, LastNewRow As Long, ColNum As Long, WS1 As Worksheet, WS2 As Worksheet
 
  Const ExistingNamesColumn As String = "A"
  Const NewNamesColumn As String = "B"
  Set WS1 = Worksheets("Sheet1")
  Set WS2 = Worksheets("Sheet2")
 
  NextOldRow = WS1.Cells(Rows.Count, ExistingNamesColumn).End(xlUp).Row + 1
  LastNewRow = WS2.Cells(Rows.Count, NewNamesColumn).End(xlUp).Row
  Application.ScreenUpdating = False
  WS2.Range(NewNamesColumn & "1:" & NewNamesColumn & LastNewRow).Copy WS1.Cells(NextOldRow, ExistingNamesColumn)
  WS1.Columns(ExistingNamesColumn).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub