Thread: Using Find in a Loop

I have a list of 50000+ items in column A with their corresponding quantities in column B. There are duplicate items in A and I want to combine the quantities of the duplicate items then remove the duplicates rows.

Doing this in For-Next loops takes hours to complete. I am looking for a quicker method such as using the Find statement.

Thanks

can you try this experiment
keep the original file safe somewhere.
I presume that in sheet col A and B have column heading in row 1.
goto sheet2

selecst A1 in sheet2
click data(menu bar)-filter-advance filter

in teh advance filter window
against list ramge type
Sheet1!$A$1:$A$5000(row 5000 is the last row)
leave criteria range blank
choose "copy to another locations" at the top
click "unique records only" at the bottom
then in "copy to type
$A$1 (if it is not there already.

click Ok in the advance filter window.

you get unique values of column A of sheet 1 in column A of sheet 2

in cell B2 of sheet 2 type this formula

=SUMPRODUCT((Sheet1!$A$2:$A$5000=A2)*(Sheet1!$B$2:$B$5000))

copy this down to the last row.

will this take less time than a macro

Try:
expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

an good example

Sub FindCatOtherSheet()

Dim rFound As Range



    On Error Resume Next

    With Sheet1

        Set rFound = .Columns(1).Find(What:="Cat", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _

            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

            , SearchFormat:=False)

    On Error GoTo 0

        If Not rFound Is Nothing Then Application.Goto rFound, True

    End With
End Sub

Plz see more detail at the link: http://www.ozgrid.com/VBA/find-method.htm

Ref: http://www.ozgrid.com/VBA/find-method.htm

OR other example with loop:

Example

This example finds all cells in the range A1:A500 on worksheet one that contain the value 2 and changes it to 5.

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

ref: http://msdn.microsoft.com/en-us/libr...ffice.11).aspx

venkat1926 - Copying a formula to 50,000 cells is not an effecient way to do this.

Leith Ross - Got an avtivex error on the DSO line. Besides this is not a FIND method

tigertiger - I already saw these codes online but none actually does the job correctly. The Find lines either miss the first match, or give unexpected results. Try them on a sample of 10 or so rows and see what I mean.

Any other ideas?

Originally Posted by matrex

tigertiger -....The Find lines either miss the first match, or give unexpected results. Try them on a sample of 10 or so rows and see what I mean.
Any other ideas?

You should combine Find and For loop
I am trying to write the example-code for you

Pike - A great piece of code. Worked brilliantly in one workbook but gave an error on " With Sheet1.UsedRange" line on the another workbook. I'm still trying to figure out what's causing the error.

Originally Posted by Leith Ross

Hello matrex,
Did you mean "Acitve X" ?

that is Active X for CreateObject("Scripting.Dictionary")
in your SUB

try this SUB

Public Sub findx()

Const StartRow = 2
Dim c, firstAddress, iR As Long, eR As Long, Q, Sh0 As Worksheet

Set Sh0 = Application.ActiveSheet

eR = Sh0.Range("A" & Rows.Count).End(xlUp).Row
Dim aCo() As Byte: ReDim aCo(eR) As Byte: For iR = 0 To eR: aCo(iR) = 0: Next

For iR = StartRow To eR
    If Sh0.Cells(iR, "A").Value2 = "" Then
        aCo(iR) = 2
    Else
        If aCo(iR) = 0 Then
            
            firstAddress = Sh0.Cells(iR, "A").Address
            Q = Sh0.Cells(iR, "A").Offset(, 1).Value2
            
            With Sh0.Range("a" & iR & ":a" & eR)
                Set c = .Find(Sh0.Cells(iR, "A").Value2, LookIn:=xlValues, LookAt:=xlWhole)
                Do While Not c Is Nothing And c.Address <> firstAddress
                    aCo(c.Row) = 1
                    If Q = c.Offset(, 1).Value2 Then aCo(c.Row) = 2
                    Set c = .FindNext(c)
                Loop
            End With
        End If
    End If
Next iR
For iR = eR To StartRow Step -1
   If aCo(iR) = 2 Then Sh0.Rows(iR).Delete
Next iR

End Sub

Leith Ross - Yes I meant mean "Acitve X". Sorry about the typo.

tigertiger - tried it on this sample list but nothing seems to happen!
AAA 2
BBB 2
AAA 1
AAA 4
FFF 3
GGG 2
GGG 1
RRR 4
AAA 3
BBB 1

Thanks so much everyone for all your help.

matrex

Originally Posted by matrex

AAA 2
BBB 2
AAA 1
AAA 4
FFF 3
GGG 2
GGG 1
RRR 4
AAA 3
BBB 1

hiiiiiii
it does not match your problem that you present in your original post:

There are duplicate items in A and I want to combine the quantities of the duplicate items then remove the duplicates rows.