Hi Paul,
Please stop mailing me. Gr. Herman -----Oorspronkelijk bericht----- Van: excel-macros@googlegroups.com [mailto:excel-mac...@googlegroups.com] Namens Paul Schreiner Verzonden: woensdag 24 november 2010 14:47 Aan: excel-macros@googlegroups.com Onderwerp: Re: $$Excel-Macros$$ Re: Long List problem OK, here's something to work with: My sample list (Sheet ValueList) has 65000 rows. the userform (Form_SelectList) loads the UNIQUE values (6100) into a listbox called List_SelectFrom You enter any number of words into the The Text box (txt_Filter) and hit the button (Btn_Filter) which then reloads the listbox with records that contain the keywords. Give it a try and see what you think. Paul -------------------------------------------------- Userform: Option Explicit Private Sub Btn_Cancel_Click() Unload Form_SelectList End Sub Private Sub Btn_Filter_Click() Dim I, X, FilterCnt, FilterArray, SelFlag Form_SelectList.List_SelectFrom.Clear FilterArray = Split(Replace(UCase(Form_SelectList.Txt_Filter.Value), ",", " "), " ") For X = 1 To UBound(ValArray) SelFlag = True For I = 0 To UBound(FilterArray) If (InStr(1, ValArray(X), FilterArray(I)) <= 0) Then SelFlag = False Exit For End If Next I If (SelFlag) Then Form_SelectList.List_SelectFrom.AddItem ValArray(X) End If Next X End Sub Private Sub Btn_Select_Click() Sheets(CurSht).Range(CurCell).Value = Form_SelectList.List_SelectFrom.List(Form_SelectList.List_SelectFrom.ListIndex) Unload Form_SelectList End Sub Private Sub Txt_Filter_Change() If (Form_SelectList.Txt_Filter.Value <> UCase(Form_SelectList.Txt_Filter.Value)) Then Application.EnableEvents = False Form_SelectList.Txt_Filter.Value = UCase(Form_SelectList.Txt_Filter.Value) Application.EnableEvents = True End If End Sub Private Sub UserForm_Initialize() Dim I, X Load_SelectList For X = 1 To UBound(ValArray) Form_SelectList.List_SelectFrom.AddItem ValArray(X) Next X Form_SelectList.Txt_Filter.SetFocus End Sub Module: Option Explicit Public ValArray Public CurCell, CurSht Sub Load_SelectList() Dim Dict_SelList, RowCnt, R, ValSht Dim SortFlag, tmpVal Dim LoopCnt Application.ScreenUpdating = False ValSht = "ValueList" Set Dict_SelList = CreateObject("Scripting.Dictionary") Dict_SelList.RemoveAll CurCell = ActiveCell.Address CurSht = ActiveSheet.Name Sheets(ValSht).Select RowCnt = ActiveCell.SpecialCells(xlLastCell).Row Sheets(CurSht).Select On Error Resume Next For R = 2 To RowCnt If (R Mod 1000 = 0) Then Application.StatusBar = "Processing " & R & " of " & RowCnt If (Sheets(ValSht).Cells(R, "A").Value & "X" <> "X") Then If (Not Dict_SelList.exists(UCase(Sheets(ValSht).Cells(R, "A").Value))) Then Dict_SelList.Add UCase(Sheets(ValSht).Cells(R, "A").Value), R End If End If Next R ' ReDim ValArray(Dict_SelList.Count) ' For R = 1 To Dict_SelList.Count ValArray = Dict_SelList.keys Application.StatusBar = "Sorting Values" LoopCnt = 0 SortFlag = True While SortFlag LoopCnt = LoopCnt + 1 If (LoopCnt Mod 100 = 0) Then Application.StatusBar = "Sorting Values: " & LoopCnt If (LoopCnt > UBound(ValArray) * 100) Then MsgBox "Excessive sorting, try sorting data first" Exit Sub End If SortFlag = False For R = 1 To UBound(ValArray) If (ValArray(R - 1) > ValArray(R)) Then SortFlag = True tmpVal = ValArray(R - 1) ValArray(R - 1) = ValArray(R) ValArray(R) = tmpVal ' Exit For End If Next R Wend On Error GoTo 0 Application.StatusBar = False Application.ScreenUpdating = True End Sub ----- Original Message ---- > From: Manish Pansari <pansari.man...@gmail.com> > To: MS EXCEL AND VBA MACROS <excel-macros@googlegroups.com> > Sent: Wed, November 24, 2010 5:52:04 AM > Subject: $$Excel-Macros$$ Re: Long List problem > > Hi, > > > Any help please > > > Thanks > > On Nov 24, 11:17 am, Manish Pansari <pansari.man...@gmail.com> wrote: > > Hi All members, > > > > I have data in more than 2000 rows. I created drop down list through > > data validation option in excel. But its very hard and difficult to > > search the required name through long list. > > I want to create a macro with search option user form. When I click > > the macro, one user form will open and I can search the value (Colm > > A:A Value) and insert it in active cell. My idea is like MS Outlook > > contact book, when we want insert contact, we can search and select > > the required contact. > > Pls help me. > > > > - > > Manish > > -- >---------------------------------------------------------------------------------- >- > Some important links for excel users: > 1. Follow us on TWITTER for tips tricks and links : >http://twitter.com/exceldailytip > 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 > 3. Excel tutorials at http://www.excel-macros.blogspot.com > 4. Learn VBA Macros at http://www.quickvba.blogspot.com > 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com > > To post to this group, send email to excel-macros@googlegroups.com > > <><><><><><><><><><><><><><><><><><><><><><> > Like our page on facebook , Just follow below link > http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts > -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
