Find unique values where criteria is met

  • Hi, this is similiar to the thread:
    Vlookup & Copypaste by adncmm1980
    however, a bit different and as to not complicate that thread I thought it best to just start a new one.

    What I would like to do is like this:
    varB as string and already assigned
    varC = sheets("x").range("z")

    working with sheets("a"):

    for every unique value in column A where column B = varB, assign that unique column A value to offset(1, 0) from varC
    ... then assign the count of that unique column A value (where varB is true) to offset(1, 1)
    continue looping and offsetting 1 row down for each new A value group.

    I really am not even coming close to accomplishing this myself.
    If the above doesn't really make sense, what I am trying to do is select a person from a list and then find all of the clients that person has handled. - person=varB, clients=unique a values. The person and client columns on my 'retrieved_data' sheet (3500 lines) contain over 50 unique values each.

    A rather pathetic attempt, though it was my latest attempt ... problem is I can't see how it's done in my mind ... earlier I tried sorting and finding, but I couldn't get that to work, maybe it's best though ?

    Appreciate help, thx

    <b><font color="#23069E">_NFio_</font></b>

  • Re: Find unique values where criteria is met

    Sounds like it would be done a lot easier with a database program and exporting data than messing around with code. Thats just my opinion, wish I could help more.

  • Re: Find unique values where criteria is met

    Thanx xigol, I'm sure that would be easier, but unfortunately it's not built that way... for example - if it were sql I could do something as easy as :
    SELECT DISTINCT client FROM table WHERE am=’person name’

    It's actually so simple ... I can't believe that it's so complicated in vb ...
    i mean, has it never been needed to list distinct values from column A where column B value = "whatever" ... seems like it would be a semi-routine query ...

    Thanks though ...

    <b><font color="#23069E">_NFio_</font></b>

  • Re: Find unique values where criteria is met

    Hi Richie,

    kewlness, here's a file with a list and a sloppy macro sub which you'll just want to throw away, but it leaves a bit of what's left of a trail of various stuff I've tried.

    I had to delete a bunch of stuff to scrunch the file 2 b under the upld sz lmt ... but you should get the jist of it ...


  • Re: Find unique values where criteria is met

    Hi N,

    OK, based upon your description of the problem and the data contained in the example workbook it appears that:

    1. The 'Person' data is contained in column G.
    2. The 'Client' data is contained in column F.
    3. For each Person we want to find a unique list of the Clients.

    The following routine uses the AdvancedFilter to produce a unique list of the Persons in column M. It then uses this list as the criteria for applying a series of AutoFilters to column G.

    While the (auto)filter is applied a range variable is set that equals the Clients that are visible. The routine then loops through this range and uses a Collection object to create a unique list of Clients. For a description of how this part works see JW's tip here :

    Finally, we loop though the contents of the Collection and add them in the columns alongside the Person (ie from column N onwards).

    Here is the routine. Please feel free to modify it if I have misunderstood your requirements. ;)
    [vba]Sub ClientsForPersons()
    Dim wsData As Worksheet
    Dim rngPersons As Range, rngUnique As Range
    Dim rngClients As Range, rngCell1 As Range, rngCell2 As Range
    Dim colUnique As New Collection, lCnt As Long

    Set wsData = ThisWorkbook.Worksheets("retrieved_data")

    Application.ScreenUpdating = False

    With wsData

    Set rngPersons = .Range("G1:G" & .Cells(Rows.Count, "G").End(xlUp).Row)
    rngPersons.AdvancedFilter _
    Action:=xlFilterCopy, CopyToRange:=.Range("M1"), Unique:=True
    Set rngUnique = .Range("M2:M" & .Cells(.Rows.Count, "M").End(xlUp).Row)
    'produce a list of all the persons

    For Each rngCell1 In rngUnique
    rngPersons.AutoFilter Field:=1, Criteria1:=rngCell1.Value
    Set rngClients = .AutoFilter.Range.Offset(1, -1) _
    .Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    On Error Resume Next
    For Each rngCell2 In rngClients
    colUnique.Add rngCell2.Value, CStr(rngCell2.Value)
    Next rngCell2
    On Error GoTo 0
    For lCnt = 1 To colUnique.Count
    rngCell1.Offset(0, lCnt).Value = colUnique(lCnt)
    Next lCnt
    Set colUnique = Nothing
    Next rngCell1
    'find unique clients for each person

    End With

    Application.ScreenUpdating = True

    End Sub[/vba]HTH

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!