Thread: unique values into an array?

Hi all,

I've searched here and on google, but haven't found what I'm looking for. So, I'll post it instead:

I have a long list of values in Column A, several thousand of them. However, only 10 or so are unique values. I already have some code (below) to count the unique values, but what I'd also like is to create an array of those values as text to be used later for making sheets with a specific name. Here's the counting code I found:

Code:

Function CountUniqueValues(InputRange As Range) As Integer
Dim cl As Range, UniqueValues As New Collection


    Application.Volatile
    On Error Resume Next ' ignore any errors
    For Each cl In InputRange
        UniqueValues.Add cl.Value, CStr(cl.Value) ' add the unique item
    Next cl
    On Error GoTo 0
    CountUniqueValues = UniqueValues.Count
End Function

How do I push each unique value into an array element?

Thanks,
Adam

Advanced Filter?

Code:

Sub x()
    ListUniqueValues Range("A1:A10001"), Range("B1")
End Sub

Sub ListUniqueValues(rInp As Range, rOut As Range)
    rInp.AdvancedFilter Action:=xlFilterCopy, _
                        CopyToRange:=rOut, _
                        Unique:=True
End Sub

The top row must be a header.

Functions are awesome for returning calculations into a cell with nothing more than a formula...later when you're employing the function, that is.

If your goal is to evaluate a column and create a set of worksheets with the names of those values, I would opt for a regular macro to accomplish that. I do that very process quite often.

Also, in doing so, getting unique values from a column is instantaneous with the Advanced Filter.

Here's my stock macro for taking a set of data on a specific sheet...creating an array of the values in a specified column (column A = 1), then copy the rows of data from that data set to new sheets. Each sheet is named for the unique value and results in only that value's rows of data. The technique employed here creates an array called MyArr that holds all your unique values from column A, just like you've requested.

Code:

Sub ParseItems()
'JBeaucaire  (11/11/2009)
'Based on selected column, data is filtered to individual sheets
'Creates sheets and sorts alphabetically in workbook
Dim LR As Long, i As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String
Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
   vCol = 1
   
'Sheet with data in it
   Set ws = Sheets("Data")

'Range where titles are across top of data, as string
    vTitles = "A1:Z1"
    
'Spot bottom row of data
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
For i = 1 To UBound(MyArr)
    ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(i)
    
    If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then    'create sheet if needed
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
    Else                                                     'clear sheet if it exists
        Sheets(MyArr(i)).Move After:=Sheets(Sheets.Count)
        Sheets(MyArr(i)).Cells.Clear
    End If
    
    ws.Range("A1:A" & LR).EntireRow.Copy Sheets(MyArr(i)).Range("A1")
    ws.Range(vTitles).AutoFilter Field:=vCol
    MyCount = MyCount + Sheets(MyArr(i)).Range("A" & Rows.Count).End(xlUp).Row - 1
    Sheets(MyArr(i)).Columns.AutoFit
Next i

'Cleanup
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = True
End Sub

Thanks for the code, JBeaucaire! It works well and is a great starting block for me to build from. If I've already got plans to use autofilters on the Data sheet, what's the tweak to get your code to only copy the non-filtered rows to the new sheets? And, how do you 'cleanup' the fact that your Data sheet now has put data in the EE column and 65536 row? I'd like Ctrl+Shft+End to still take me to the last cell of actual data after all's said and done.

-Adam

How do you 'cleanup' the fact that your Data sheet now has put data in the EE column and 65536 row?

You must have stopped the code midstream. There is code in there to clear out the temporary listing in column EE.

Code:

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

I'd like Ctrl+Shft+End to still take me to the last cell of actual data after all's said and done.

Try this:

Code:

Range("A1").SpecialCells(xlCellTypeLastCell).Select

I'm not stopping the code midstream, but it is inconsistent, so I must not be replicating the initial conditions the same every time. I'll look at that.

To my other question, is there a way to only copy the non-filtered values for each set corresponding to the new sheet?

Originally Posted by ahartman

...it is inconsistent, so I must not be replicating the initial conditions the same every time. I'll look at that.

Do let me know. I've never had that column left uncleared, so if there's a hole I would definitely like to plug it. Post up a misbehaving workbook if you can replicate that...thanks for the feedback.

To my other question, is there a way to only copy the non-filtered values for each set corresponding to the new sheet?

I'm not sure what you mean by non-filtered rows. This is designed to split a larger dataset up by the column you select, so all the copy jobs are based on the values being filtered.

Are you saying that each time you filter the data, you want to see all the rows that DON'T match that particular value in the filtered column? If so, change the criteria on the filter to:

Code:

For i = 1 To UBound(MyArr)
    ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:="<>" & MyArr(i)

See if that works for you. If not, more detail on what you mean by non-filtered data, or perhaps a small sample workbook demonstrating your goal.

What I'm saying is this:

1) I will filter the data based on some criteria.
2) This will leave a data set that has perhaps 10% of the original rows, but still have many instances of unique values in column A. The data are parts listed for a job, with multiple jobs listed one after another.
3) I would like to copy all the rows of data which have survived my filtering, such that all those parts belonging to Job1 get copied to the Job1 sheet, those for Job2 go to the Job2 sheet, etc. I get this functionality by applying all my filters manually, then filtering for Job1, selecting all the data (Ctrl+Shft+End), copying, and pasting to a new sheet.
4) My end result is that each Job sheet has the small subset of filtered items from the original Data sheet which met my filtering criteria and were listed for that Job#.

Is that more clear? I'm avoiding filtering the data on each sheet individually, or applying the filters over and over again, simply to speed up execution. I'd want to filter it all the way I want, then pick out each Job's data and copy that.

Hmm, I really hate working this way. A sample workbook would demonstrate immediately what your after instead of this back and forth, you know?

So, you want to filter by a column of unique values, then filter THAT data for another subset? That seems straightforward, we'd just need a clearly presented example. Again, a sample workbook is best.

Here's what the final should look like. If I apply the filters:

Cost = $2
Size = m

I get a certain subset of my original data.

If I then filter:

Job = 1

and copy/paste that data to sheet 1, I get what's shown on sheet 1.

Repeat for filters:

Job = 2
Job = 3

and the results are shown on sheets 2 and 3, respectively.

Hopefully, that's more clear?

Yeah, that's a bit more steps to go through. If you start with a fully demonstrated sample sheet like that, we can get this done in many fewer posts...

This requires that those $ symbols stay in the cost column.

Code:

Option Explicit

Sub ParseItems()
'JBeaucaire  (3/8/2009)
'Based on selected column, data is filtered to individual sheets
'Creates sheets and sorts alphabetically in workbook
'Prompt for preliminary pre-filters
Dim LR As Long, i As Long
Dim vCol As Long, vCostCol As Long, vSizeCol As Long
Dim vCost As String, vSize As String
Dim ws As Worksheet, MyArr As Variant
Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
   vCol = 1
   vCostCol = 5
   vSizeCol = 3
'Sheet with data in it
   Set ws = Sheets("Data")

'Spot bottom row of data
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Collect pre-filter values
    vCost = Application.InputBox("Which cost grouping? (enter a whole number)", "Cost group", 2, Type:=2)
    If vCost = "False" Then
        If MsgBox("Continue with ALL cost groups?", vbYesNo + vbQuestion) = vbNo Then
            GoTo ErrorExit
        Else
            vCost = "$*"
        End If
    Else
        vCost = "$" & vCost
    End If
        
    vSize = Application.InputBox("Which Size?" & vbLf & vbLf & "Small = s " & vbLf & "Medium = m" & vbLf & "Large = l", "Size", "m", Type:=2)
    If vSize = "False" Then
        If MsgBox("Continue with ALL sizes?", vbYesNo + vbQuestion) = vbNo Then
            GoTo ErrorExit
        Else
            vSize = "*"
        End If
    End If
    
'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

'Turn on the autofilter
    With ws
        .Cells.AutoFilter Field:=vCostCol, Criteria1:="=" & vCost
        .Cells.AutoFilter Field:=vSizeCol, Criteria1:=vSize

'Loop through list one value at a time
    For i = 1 To UBound(MyArr)
            .Cells.AutoFilter Field:=vCol, Criteria1:=MyArr(i)
        
        If Not Evaluate("=ISREF('" & MyArr(i) & "'!A1)") Then    'create sheet if needed
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(i)
        Else                                                     'clear sheet if it exists
            Sheets("" & MyArr(i)).Move After:=Sheets(Sheets.Count)
            Sheets("" & MyArr(i)).Cells.Clear
        End If
        
        .Range("A1:A" & LR).EntireRow.Copy Sheets("" & MyArr(i)).Range("A1")
        .Cells.AutoFilter Field:=vCol
        Sheets("" & MyArr(i)).Columns.AutoFit
    Next i

'Cleanup
    .AutoFilterMode = False
End With

ErrorExit:
    ws.Activate
    Application.ScreenUpdating = True
End Sub