PDA

View Full Version : Add new items to list



theta
01-27-2012, 03:41 AM
Hi All

I have a simple problem but looking for a simple / clean way to address it.

I have a sheet "NOTES" that contains a list of REF numbers in column A (with additional information that I manually input into columns B & C)

I have a macro that imports a CSV into sheet "DATA IMPORT". This also contains a "REF" column

I need to macro or method to go through the "REF" in sheet "DATA IMPORT" and copy anything that is new into the sheet "NOTES" (i.e. it isnt already there)

Would a collection or array work? REF is a primary key and unique. So just look for new items in column A on sheet "DATA IMPORT" and add it to column A on sheet "NOTES" - so that information can be recorded against it

Any help appreciated and example code, I don't have a clue where to start :/

mdmackillop
01-27-2012, 06:46 AM
Sub Unique()
Dim Tgt As Range, Srce As Range, cel as Range
Set Tgt = Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
Set Srce = Sheets(2).Columns(1).SpecialCells(xlCellTypeConstants)
For Each Cel In Srce
If Tgt.Find(Cel, lookat:=xlWhole) Is Nothing Then
Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2) = Cel
End If
Next
End Sub

theta
01-27-2012, 06:57 AM
Hmmm....I ran this code and it doesn't seem to do anything!?

Can you make it colour cells or something so that I can see how it works, normally I see people using collections and keys but your way looks very simple (so would love to get it working)

theta
01-27-2012, 07:28 AM
Sorry got it working now!

It was checking in a different direction. So I placed unique items in Sheet1 not Sheet2 so nothing was copying :)

Now I will expand on this. I am going to pull across columns B, C, D & E based on the match (or lack of match) in Col A

What is the most elegant way to do this (before I start hacking away at the code)

theta
01-27-2012, 07:36 AM
Can you please explain the logic behind how this works - it is very simple code that is going to prove VERY useful in alot of projects I work on




Sub Unique()
Dim Tgt As Range, Srce As Range, cel As Range, current As Range
Set Tgt = Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
Set Srce = Sheets(2).Columns(1).SpecialCells(xlCellTypeConstants)
For Each cel In Srce
If Tgt.Find(cel, lookat:=xlWhole) Is Nothing Then
Set current = Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2)
current = cel
current.Offset(0, 1) = cel.Offset(0, 1)
current.Offset(0, 2) = cel.Offset(0, 2)
current.Offset(0, 3) = cel.Offset(0, 3)
End If
Next
End Sub

mdmackillop
01-27-2012, 10:58 AM
You can do the copying in one step
current.resize(,4).value = cel.resize(,4).value
Comments added
Sub Unique()
Dim Tgt As Range, Srce As Range, cel As Range, current As Range
'Define the ranges to be looked at. The SpecialCells limits this to cells with values
Set Tgt = Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
Set Srce = Sheets(2).Columns(1).SpecialCells(xlCellTypeConstants)
'using each value
For Each cel In Srce
'Test for a match
If Tgt.Find(cel, lookat:=xlWhole) Is Nothing Then
'Find the cell below the last cell in the column
Set current = Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2)
'add the new data
current.Resize(, 4).Value = cel.Resize(, 4).Value
End If
Next
End Sub