Sorry Herman, I didn't mail you directly. You received this because you've subscribed to the Excel-Macros group in Google. (actually, it's called: MS EXCEL AND VBA MACROS)
I simply responded to a message posted to the group. If you would like to stop receiving emails from the GROUP, you need to log into the Google Group site: http://groups.google.com/ access your account, (My Account) select the "Groups - Manage Subscriptions" option. Here you can select to receive indiviual emails, Abrigdged emails, or none at all. Sorry for the inconvenience. Paul ----- Original Message ---- > From: Herman Esmeijer <h.esmei...@aldipress.nl> > To: excel-macros@googlegroups.com > Sent: Wed, November 24, 2010 8:51:40 AM > Subject: RE: $$Excel-Macros$$ Re: Long List problem > > 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 e 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
