Unique -> add new unique values under

[Emperor]

Hi all,

I've got a large list with projects from which, at this time come about 130 Unique values.
Behind this unique list I put several data, so this list can't be moved anymore.

What I need is a button on my userform which looks at the Unique-list, checks into the data sheet if there are new Uniques, and if yes, add them under the current uniques.

Data is:
Worksheets("data").range("A:A")

Uniques list
Worksheets("projects").range("A4") and down

Any help is welcome!

Mathijs

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26May27
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] shts [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] sNum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
 
shts = Array("data", "projects")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] sNum = 0 To UBound(shts)
 [COLOR="Navy"]With[/COLOR] Sheets(shts(sNum))
       [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
       [COLOR="Navy"]If[/COLOR] sNum = 1 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] Rng = Rng.Offset(4)
   [COLOR="Navy"]End[/COLOR] With
        
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR] .Add Dn.Value, ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] sNum
Sheets("data").Range("A1").Resize(.Count) = Application.Transpose(.keys)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[p45cal]

select Worksheets("data").range("A:A") or as much of it as you want.
Copy it,
Paste it under existing Worksheets("projects").range("A4") and down.
Select new entire Worksheets("projects").range("A4") and down
Data|Data Tools|Remove Duplicates

 

[p45cal]

select Worksheets("data").range("A:A") or as much of it as you want.
Copy it,
Paste it under existing Worksheets("projects").range("A4") and down.
Select new entire Worksheets("projects").range("A4") and down
Data|Data Tools|Remove Duplicates

Translated to a macro:

Sub blah()
    With Sheets("data")
        Intersect(.Range("A:A"), .UsedRange).Copy Sheets("Projects").Range("A4").End(xlDown).Offset(1)
    End With
    With Sheets("Projects")
        .Range(.Range("A4"), .Range("A4").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    End With
End Sub

 

[Emperor]

Thanks both for your replies, however both don't work for me;

p45cal;
I get an error on

.Range(.Range("A4"), .Range("A4").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo

'The property or method is not supported by this object'

MickG;
Your code works the wrong way arround, the projects need to be copied from the data sheet to the project sheet.
When I try to change this, it's still not good. When I run your code twice, it copies the most of the data for a second time. (there are 125 uniques, it copies 96 rows in the second run)

Thanks for your time.

Mathijs

 

[p45cal]

What version of Excel, always useful in the first post, or put it into your signature?

 

[Emperor]

Yeah sorry, normally I allways say it...

Excel 2003.

Thanks again.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26May22
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] shts [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] sNum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
 
shts = Array("projects", "data")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] sNum = 0 To UBound(shts)
 [COLOR="Navy"]With[/COLOR] Sheets(shts(sNum))
       [COLOR="Navy"]Set[/COLOR] rng = .Range(.Range("A4"), .Range("A" & Rows.Count).End(xlUp))
       [COLOR="Navy"]If[/COLOR] sNum = 1 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
   
   [COLOR="Navy"]End[/COLOR] With
        
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR] .Add Dn.Value, ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] sNum
Sheets("projects").Range("A4").Resize(.Count) = Application.Transpose(.keys)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Emperor]

Goodmorning Mick,

I have tested your new code and still have the same problems?
Could I mail you a sample file?
Or share it somewhere?

Thanks!

Mathijs

 

[MickG]

You could post it on somwhere like "4Shared.com", or you could simply insert a border around a sample of your data from both sheets (To form a grid) and copy and paste them to the Thread.
Mick