Any help pls....
On Nov 25, 10:53 am, Manish Pansari <pansari.man...@gmail.com> wrote:
> Hi Paul,
>
> Thanks a ton for your help.
>
> I am financial guy and I know only 20% coding in VBA. I am on the way
> to learn VBA.
>
> I get an idea with following code. I need one textbox in same form
> above the unique item text box to search the item from unique item
> list.
> Further this form takes lot of time to search unique item. How can we
> make it fast?? If it’s not possible, than I am not want short the data
> for unique item.
>
> Modules:
>
> Option Explicit
> ' This example is based on a tip by J.G. Hussey,
> ' published in "Visual Basic Programmer's Journal"
>
> Sub RemoveDuplicates()
> Dim AllCells As Range, Cell As Range
> Dim NoDupes As New Collection
> Dim i As Integer, j As Integer
> Dim Swap1, Swap2, Item
>
> ' The items are in A1:A65000
> Set AllCells = Range("A1:A65000")
>
> ' The next statement ignores the error caused
> ' by attempting to add a duplicate key to the collection.
> ' The duplicate is not added - which is just what we want!
> On Error Resume Next
> For Each Cell In AllCells
> NoDupes.Add Cell.Value, CStr(Cell.Value)
> ' Note: the 2nd argument (key) for the Add method must be a
> string
> Next Cell
>
> ' Resume normal error handling
> On Error GoTo 0
>
> ' Update the labels on UserForm1
> With UserForm1
> .Label1.Caption = "Total Items: " & AllCells.Count
> .Label2.Caption = "Unique Items: " & NoDupes.Count
> End With
>
> ' Sort the collection (optional)
> For i = 1 To NoDupes.Count - 1
> For j = i + 1 To NoDupes.Count
> If NoDupes(i) > NoDupes(j) Then
> Swap1 = NoDupes(i)
> Swap2 = NoDupes(j)
> NoDupes.Add Swap1, before:=j
> NoDupes.Add Swap2, before:=i
> NoDupes.Remove i + 1
> NoDupes.Remove j + 1
> End If
> Next j
> Next i
>
> ' Add the sorted, non-duplicated items to a ListBox
> For Each Item In NoDupes
> UserForm1.ListBox1.AddItem Item
> Next Item
>
> ' Show the UserForm
> UserForm1.Show
> End Sub
>
> User Form:
> Private Sub OKButton_Click()
> ActiveCell = ListBox1.Value
> Unload Me
> End Sub
>
> I don't have rights to shere my file on group. How can i shere my file
> with you?? Thanks in advance.
>
> -
> Manish
>
> On Nov 24, 7:53 pm, Paul Schreiner <schreiner_p...@att.net> wrote:
>
>
>
> > 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 athttp://www.excel-macros.blogspot.com
> > > > 4. Learn VBA Macros athttp://www.quickvba.blogspot.com
> > > > 5. Excel Tips and Tricks athttp://exceldailytip.blogspot.com
>
> > > > To post to this
>
> ...
>
> read more »- Hide quoted text -
>
> - Show quoted text -
--
----------------------------------------------------------------------------------
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
