after getting unique value u can select a unique list. insert-->name-->define(now name and range of unique values)
data-->validation-->allow-->list(name of list which u define in insert name define) your unique data list is ready now to work. On Wed, Dec 23, 2009 at 1:48 PM, rf1234 rf1234 <rfhyd1...@gmail.com> wrote: > '''''''''''''''''''''''''''distinct value string or numerical > > example 1 > suppose in sheet1 range c1 u have a value > > January February March April May June January February March April May > June January February March April January February March April May June > > output should be as follows > February March April May June January > > > example 2(in case of numeric) > suppose in sheet1 range c1 u have a value > 1 1 2 2 3 3 3 4 5 6 7 8 9 10 11 > > output should be as follows > > 1 2 3 4 5 6 7 8 9 10 11 > > note that--->sheet1 c1 range has a current value > and sheet3 a1 has distinct value after macro run > > ''''''''here is the code > > Option Explicit > ''''''''''FORE MORE HELP VISIT > http://groups.google.com/group/excel_vba''''''''''''''''''''''''''''''''''''''' > ''''''''''''''''''''''''''''''''''''''''''''''''' > Sub MergeDistinct() > '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > ' MergeDistinct > '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' > Dim R As Range ' Range loop variable. > Dim LastCell As Range ' Last cell in input columns. > Dim WS As Worksheet ' Worksheet reference. > Dim N As Long ' Result of duplicates test. > Dim M As Long ' Rows in merged list. > Dim StartList1 As Range ' First cell of first list to merge. > Dim StartList2 As Range ' First cell of second list to merge. > Dim StartOutputList As Range ' First cell of merged list. > Dim ColumnToMatch As Variant ' Column in input lists to test for > duplicates. > Dim ColumnsToCopy As Long ' Number of columns in each input list to > copy to output. > ' This is the column in the input lists > ' that is to be tested for duplicates. > ColumnToMatch = "C" > ' This is the number of columns from each list to > ' be merged that are copied to the result list. > ColumnsToCopy = 3 > ' The output list begins in this cell. > Set StartOutputList = Worksheets("Sheet3").Range("A1") > ' The first list to be merged starts here. > Set StartList1 = Worksheets("Sheet1").Range("C1") > Set WS = StartList1.Worksheet > With WS > M = 1 > ' Get the last used cell in the first list to be merged. > Set LastCell = .Cells(.Rows.Count, StartList1.Column).End(xlUp) > ' Loop through the range of values > For Each R In .Range(StartList1, LastCell) > If R.Value <> vbNullString Then > N = Application.CountIf(StartOutputList.Resize(M, 1), _ > R.EntireRow.Cells(1, ColumnToMatch).Text) > ' If N = 0, then the item is not in the merged result > ' list, so copy the data over. If N > 0, we've already > ' encountered the value, so do nothing. > If N = 0 Then > StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _ > R.Resize(1, ColumnsToCopy).Value > ' M is the number of rows in the merged list. Increment it. > M = M + 1 > End If > End If > Next R > End With > ' The second list to be merged starts here. > Set StartList2 = Worksheets("Sheet2").Range("C1") > Set WS = StartList2.Worksheet > With WS > Set LastCell = .Cells(.Rows.Count, StartList2.Column).End(xlUp) > For Each R In .Range(StartList2, LastCell) > If R.Value <> vbNullString Then > N = Application.CountIf(StartOutputList.Resize(M, 1), _ > R.EntireRow.Cells(1, ColumnToMatch).Text) > If N = 0 Then > StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _ > R.Resize(1, ColumnsToCopy).Value > M = M + 1 > End If > End If > Next R > End With > End Sub > ''''''''''''''''''''''''''''''''''''''''''''''''' > ''''''''''''''''''''''''''''''''''''''''''''''''' > > '''''''''''''''''Enjoy > > > > > > On Wed, Dec 23, 2009 at 3:28 AM, Vinod N <nvino...@gmail.com> wrote: > >> Hi Excel Gurus, >> >> The following macros complies a unique list from the Range("c21:c3020") >> and populated in Cell J3. However, it does not capture numerical values in >> the said range. >> >> Please help in modifiying the following macro where it can populate >> numeric as well as alphanumeric unique list >> >> >> Sub GetUnique_Collection() >> >> 'Using the Collection object >> Dim SourceRng As Range >> Dim UniqColl As New Collection >> Set SourceRng = Range("c21:c3020") >> On Error Resume Next >> For Each cell In SourceRng.Cells >> UniqColl.Add cell.Value, cell.Value >> Next >> On Error GoTo 0 >> ReDim UniqArray(1 To UniqColl.Count) >> For i = 1 To UniqColl.Count >> UniqArray(i) = UniqColl(i) >> Next >> 'Optional sort routine can be inserted here >> Range("j3").Resize(UniqColl.Count, 1).Value = >> WorksheetFunction.Transpose(UniqArray) >> End Sub >> >> -- >> Thanks and Regards >> >> Vinod N >> >> -- >> >> ---------------------------------------------------------------------------------- >> Some important links for excel users: >> 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at >> http://www.excelitems.com >> 2. Excel tutorials at http://www.excel-macros.blogspot.com >> 3. Learn VBA Macros at http://www.vbamacros.blogspot.com >> 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com >> >> >> To post to this group, send email to excel-macros@googlegroups.com >> If you find any spam message in the group, please send an email to: >> Ayush Jain @ jainayus...@gmail.com or >> Ashish Jain @ 26may.1...@gmail.com >> <><><><><><><><><><><><><><><><><><><><><><> >> HELP US GROW !! >> >> We reach over 6,500 subscribers worldwide and receive many nice notes >> about the learning and support from the group. Our goal is to have 10,000 >> subscribers by the end of 2009. Let friends and co-workers know they can >> subscribe to group at >> http://groups.google.com/group/excel-macros/subscribe > > > -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at http://www.excelitems.com 2. Excel tutorials at http://www.excel-macros.blogspot.com 3. Learn VBA Macros at http://www.vbamacros.blogspot.com 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com If you find any spam message in the group, please send an email to: Ayush Jain @ jainayus...@gmail.com or Ashish Jain @ 26may.1...@gmail.com <><><><><><><><><><><><><><><><><><><><><><> HELP US GROW !! We reach over 6,500 subscribers worldwide and receive many nice notes about the learning and support from the group. Our goal is to have 10,000 subscribers by the end of 2009. Let friends and co-workers know they can subscribe to group at http://groups.google.com/group/excel-macros/subscribe
