Page 1 of 2 12 LastLast
Results 1 to 15 of 23
  1. #1
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts

    Finding Unique Entries (again)

    I have a list of 100,000 rows with the B column containing EVENT names (text).
    The E column has an associated VENUE where the event took place (also text).

    An event may have been appeared 30 times, but in 10 unique venues.

    I'd like the user to be able to type in an event name (in a "form" sheet) and have a list of UNIQUE venues for that event.

    There could be as many as 130 unique venues for one of the events (e.g., Maud made a lot of appearances in a lot of venues).

    Can I pull this off without having to start the "lookup" for the unique results and wait overnight for the results?

    I've tried the FREQUENCY function, but because of the size of this sheet (100k rows), it takes forever (I surmise, because a small subset took an enormous amount of time).

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Kevin,

    Have you tried using an advanced filter and setting the results to a second sheet.
    You can set it up using VBA and remembering to select the unique parameter.
    advunique.JPG
    Code:
    Option Explicit
    
    Sub MyExtract()
    
        'Where:
        '  SourcesheetName = the tab (sheet) name of your 100,000 records with the appropriate range following.
        '  Criteria                     = Named Range that contains your criteria in this example D1:K2
        '  Extract                      = Named Range of the target for your results list in this example A1
    
        Sheets("SourceSheetName").Range("A1:H92").AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range("Criteria"), CopyToRange:=Range("Extract"), Unique:= _
            True
            
    End Sub
    Of course you would also have the code insert the entered value from your form in the appropriate column of the Criteria range in this example G2, BEFORE the code above! Note this data was from my cell bill, the longest list I could find so I don't know how it will scale but worth a shot.

    Also note that the dialog box shown above was for testing purposes and I recorded the macro from the dialog box. Of course you can also provide the SourceSheetName & Range via a dynamic range name to make it work even better.

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    I'm getting an error but cannot determine what I typed incorrectly.

    Sheets("AllData").Range("A1:H92192").AdvancedFilte r Action:=xlFilterCopy, _
    CriteriaRange:=Range("FindEvent!B2"), CopyToRange:=Range("FindEvent!I1"), Unique:=True

    I tried rerecording but got the error that I can only copy filtered data to the active sheet.
    Last edited by kweaver; 2014-02-19 at 21:58.

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    KW,

    Yep! Been there...done that!

    Maybe this is what you are looking for. Click on the start button and a form opens. Combobox1 will automatically be populated with all the events in Column B. There is no limit. Once you select an event, combobox2 will be populated with all the matching venues for that event. If you switch the event, the venue re-populates with new unique venues for that event. Whatever venues you assign to the corresponding event will populate combobox2 when you select that event.

    Venue.png

    Userform Code
    Code:
    Private Sub ComboBox1_Change()
    ComboBox2.Clear
    LastRow = Worksheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Row
    For I = 2 To LastRow
        If Cells(I, 2) = ComboBox1.Value Then
            ComboBox2.AddItem (Cells(I, 5))
        End If
    Next I
    End Sub
    
    Private Sub CommandButton1_Click()
    Venue.Hide
    End Sub
    
    Private Sub UserForm_Activate()
    LastRow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
    ComboBox1.Clear
    For I = 2 To LastRow
        ComboBox1.AddItem (Cells(I, 2))
    Next I
    End Sub
    Sheet1 Code
    Code:
    Private Sub CommandButton1_Click()
    Venue.Show
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2014-02-19 at 22:42.

  5. #5
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,054
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Here's a different approach. Type the event name into cell A2 of your "form" sheet, then run the following macro:
    Code:
    Sub ListVenues()
    Application.ScreenUpdating = False
    Dim StrEvent As String, lRow As Long, i As Long, ArrOut As Variant
    With ThisWorkbook
      With .Sheets(2)
        lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        StrEvent = .Range("A2").Value
        .Range("A2:B" & lRow).ClearContents
      End With
      With .Sheets(1)
        lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
        ArrOut = UniqueItemArray(StrEvent, .Range("B1:B" & lRow), .Range("E1:E" & lRow))
      End With
      With .Sheets(2)
        For i = 1 To UBound(ArrOut)
          .Range("A" & i + 1).Value = StrEvent
          .Range("B" & i + 1).Value = ArrOut(i)
        Next
      End With
    End With
    Application.ScreenUpdating = True
    End Sub
    
    Function UniqueItemArray(StrCrit As String, RngCrit As Range, RngMatch As Range) As Variant
    Dim ArrTmp() As Variant, ArrUnique() As Variant
    Dim i As Long, j As Long, k As Long, bMatch As Boolean
    j = 0: k = 0
    For i = 1 To RngCrit.Rows.Count
      If RngCrit.Cells(i).Value = StrCrit Then
        j = j + 1
        ReDim Preserve ArrTmp(j)
        ArrTmp(j) = i
      End If
    Next i
    For i = 1 To UBound(ArrTmp)
      bMatch = False
      For j = 1 To k
        If RngMatch.Cells(ArrTmp(i)).Value = ArrUnique(j) Then
          bMatch = True
          Exit For
        End If
      Next j
      If bMatch = False Then
        k = k + 1
        ReDim Preserve ArrUnique(k)
        ArrUnique(k) = RngMatch.Cells(ArrTmp(i)).Value
      End If
    Next i
    UniqueItemArray = ArrUnique
    End Function
    The reason for using cell A2 of your "form" sheet is to allow you to have 'Event' and 'Venue' column headers in A1 & B1, respectively. The Event/Venue data are output in those columns.

    Note: As coded, the macro references the input/output worksheets via their (assumed) index numbers; I'd suggest using sheet names instead. If you want to get fancy, you could even make the macro an event-driven one...
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  6. #6
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    KW,

    Combobox2 could also be changed to a listbox

    venue1.png

    If this is what you are looking for, let me know what is supposed to happen after the selections are made. OOPS...I think I misunderstood what you meant by a form sheet (not a form).

    Maud
    Last edited by Maudibe; 2014-02-19 at 23:37.

  7. #7
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    KW,

    In cell A2 on sheet 2 ("Unique Venues"), type an event from Column B on Sheet1 then click the "Filter Venues" button. Column 2 will listed with unique venues for that event.

    venue2.png

    Code:
    Sub FilterVenues()
    With Worksheets("Sheet1")
    Row = 2
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        For I = 2 To LastRow
            If .Cells(I, 2) = [b1] Then
                Cells(Row, 2) = .Cells(I, 5)
                Row = Row + 1
            End If
        Next I
        EndRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
        ActiveSheet.Range(Cells(2, 2), Cells(EndRow, 2)).RemoveDuplicates Columns:=1, Header:=xlNo
    End With
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2014-02-19 at 23:42.

  8. #8
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    WOW! Thank you for all of your replies. I will try in the morning as dinner w/a fair amount of wine will blur all of these approaches.

    Thanks again !!

  9. #9
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Quote Originally Posted by kweaver View Post
    I'm getting an error but cannot determine what I typed incorrectly.

    Sheets("AllData").Range("A1:H92192").AdvancedFilte r Action:=xlFilterCopy, _
    CriteriaRange:=Range("FindEvent!B2"), CopyToRange:=Range("FindEvent!I1"), Unique:=True

    I tried rerecording but got the error that I can only copy filtered data to the active sheet.
    Kevin,

    I can't tell what you may have typed incorrectly w/o a view of the sheet like I posted.
    As to the error when you record you must start the Advanced filter form the sheet with the Extract Range. I usually place the cursor in the cell with the test value in the Criteria range. HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  10. #10
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    RG: I'll have to see if I can slice up this huge file into something manageable to post.

    In the meantime, I created a new file on which to experiment.

    Now I have column A with the EVENTS and column B with the VENUES. In F1 I have the Event Criteria which is what I'm looking for from column A.
    For all those in Col A that match F1, I want a unique list of the venues from Col B to populate Col I.

    Maybe this is better explained now?? Hopefully.

    I've attached a sample. In the sample, I have the desired solution in Col I where the EVENT in F1 matches those in A, the unique venues start in I
    Attached Files Attached Files
    Last edited by kweaver; 2014-02-20 at 11:27.

  11. #11
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Kevin,

    See if this meets your needs. Sorry but you can't have the data and the results on the same sheet.
    Kevin Sample.xlsm
    Check out the name manager for the definition of the names used in the VBA code.
    I've setup the Dynamic Range Name for SourceData to allow up to 200,000 lines, of course you can adjust based on where your dataset will grow to.
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  12. #12
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    Worked GREAT on the sample. Where did I mess up when I moved the VBA to my file?

    Option Explicit

    Sub MyExtract()


    'Where:
    ' SourceData = is a Dynamic Range name
    ' Criteria = Named Range that contains your criteria in this example Results!A1:A2
    ' Extract = Named Range of the target for your results list in this example Results!B1
    ' Refer to the Name manager.

    Sheets("Events").Range("SourceData").AdvancedFilte r Action:=xlFilterCopy, _
    CriteriaRange:=Range("Criteria"), CopyToRange:=Range("Extract"), Unique:= _
    True

    End Sub

    I have the following as the named range for SourceData


    =OFFSET(Events!$A$1,0,0,COUNTA(Events!$A$1:$A$2000 01),2)

  13. #13
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Kevin,

    Have you checked the Range Name definitions for Criteria & Extract?
    KevinRanges.JPG
    Last edited by RetiredGeek; 2014-02-20 at 15:03.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  14. #14
    Bronze Lounger
    Join Date
    Jan 2001
    Location
    La Jolla, CA
    Posts
    1,470
    Thanks
    30
    Thanked 62 Times in 58 Posts
    My sheets are Events and Venues and I thought I had the ranges correct. See the image.
    Attached Images Attached Images

  15. #15
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Kevin,

    What error/results are you getting?
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •