Find method: using one range to search for all occurences in another

ChrisBEE1 · Dec 2nd 2005

Hello All:

I trying to use the find method with two ranges. My objective is to locate all occurences of the values of range 1 in range 2. My macro finds all the values, however, it loops to many times. Here is a copy of my code. Any help with this problem will be greatly appreciated.

TIA,
Chris

Code

Dim NextRow3 As Long
Dim NextRow As Long
Dim foundCell As Range
Dim Cell As Range
Dim rng As Range
Dim rng3 As Range
Dim tempCell As Range
Dim iLoop As Integer
Dim rng3Count As Long
Dim rng3Count1 As Long
On Error Resume Next


  
Application.ScreenUpdating = False
Set rng = Sheet2.Range("A7:A" & Sheet2.Range("A65536").End(xlUp).Offset(0, 0).Row) 'Range on Emission Process Form


Application.ScreenUpdating = False
Set rng3 = Sheet20.Range("A7:A" & Sheet20.Range("A65536").End(xlUp).Offset(0, 0).Row) 'Range on Emission Form Back-Up
  'Counts SCC Values that match TextBox1.Value
Application.ScreenUpdating = False


For Each Cell In rng


 
   If Cell.Value = "" Then
   GoTo 100
   ElseIf Cell.Value <> "" Then
   GoTo 40
   End If
   
40
   Set foundCell = rng3.Find(What:=Cell.Value, LookIn:=xlValues, _
   LookAt:=xlPart, _
   SearchOrder:=xlByRows, _
   SearchDirection:=xlNext, _
   MatchCase:=False) 'Find Method employed to match TextBox1.Value
      
  Application.ScreenUpdating = False
   NextRow3 = Sheet5.cells(Rows.Count, "a").End(xlUp).Offset(1, 0).Row 'Offset(1,0)will locate next empty row on Emission Form, column a
    Sheet5.cells(NextRow3, 1) = foundCell.Value 'Writes EUID to Emission Form
     Sheet5.cells(NextRow3, 2) = foundCell.Offset(0, 1).Value 'Writes EP to Emission Form
      Sheet5.cells(NextRow3, 3) = foundCell.Offset(0, 2).Value 'Writes Pollutant Code to Emission Form
       Sheet5.cells(NextRow3, 5) = foundCell.Offset(0, 4).Value 'Writes ERP to Emission Form
        Sheet5.cells(NextRow3, 6) = foundCell.Offset(0, 5).Value 'Writes Start Date to Emission Form
         Sheet5.cells(NextRow3, 7) = foundCell.Offset(0, 6).Value 'Writes End Date to Emission Form
          Sheet5.cells(NextRow3, 8) = foundCell.Offset(0, 7).Value 'Writes Start Time to Emission Form
           Sheet5.cells(NextRow3, 9) = foundCell.Offset(0, 8).Value 'Writes End Time to Emission Form
            Sheet5.cells(NextRow3, 11) = foundCell.Offset(0, 10).Value 'Writes Emissions Values to Emission Form
             Sheet5.cells(NextRow3, 12) = foundCell.Offset(0, 11).Value 'Writes Emission Units to Emission Form
            Sheet5.cells(NextRow3, 13) = foundCell.Offset(0, 12).Value 'Writes Emission Type to Emission Form
           Sheet5.cells(NextRow3, 14) = foundCell.Offset(0, 13).Value 'Writes Emission Factor Numeric Values to Emission Form
          Sheet5.cells(NextRow3, 15) = foundCell.Offset(0, 14).Value 'Writes Emission Factor Numerator Units to Emission Form
         Sheet5.cells(NextRow3, 16) = foundCell.Offset(0, 15).Value 'Writes Emission Factor Denominator Units to Emission Form
        Sheet5.cells(NextRow3, 17) = foundCell.Offset(0, 16).Value 'Writes Material Code to Emission Form
       Sheet5.cells(NextRow3, 18) = foundCell.Offset(0, 17).Value 'Writes Material I/O Code to Emission Form
      Sheet5.cells(NextRow3, 19) = foundCell.Offset(0, 18).Value 'Writes Material Description to Emission Form
     Sheet5.cells(NextRow3, 21) = foundCell.Offset(0, 20).Value 'Writes Emission Calc Method Code to Emission Form
    Sheet5.cells(NextRow3, 22) = foundCell.Offset(0, 21).Value 'Writes Control Status to Emission Form
   Sheet5.cells(NextRow3, 23) = foundCell.Offset(0, 22).Value 'Writes Emission Data Level to Emission Form


If foundCell Is Nothing Then
GoTo 50
End If
 
 rng3Count = WorksheetFunction.CountIf(rng3, Cell.Value) 
 Application.ScreenUpdating = False
For iLoop = 1 To rng3Count - 1
iLoop = iLoop + 0
Set tempCell = foundCell
Set foundCell = rng3.FindNext(After:=tempCell)


'NextRow will locate next empty row on the specified sheet
      Application.ScreenUpdating = False
        NextRow3 = Sheet5.cells(Rows.Count, "a").End(xlUp).Offset(1, 0).Row 'Offset(1,0)will locate next empty row on Emission Form, column a
         Sheet5.cells(NextRow3, 1) = foundCell.Value 'Writes EUID to Emission Form
          Sheet5.cells(NextRow3, 2) = foundCell.Offset(0, 1).Value 'Writes EP to Emission Form
           Sheet5.cells(NextRow3, 3) = foundCell.Offset(0, 2).Value 'Writes Pollutant Code to Emission Form
            Sheet5.cells(NextRow3, 5) = foundCell.Offset(0, 4).Value 'Writes ERP to Emission Form
             Sheet5.cells(NextRow3, 6) = foundCell.Offset(0, 5).Value 'Writes Start Date to Emission Form
              Sheet5.cells(NextRow3, 7) = foundCell.Offset(0, 6).Value 'Writes End Date to Emission Form
               Sheet5.cells(NextRow3, 8) = foundCell.Offset(0, 7).Value 'Writes Start Time to Emission Form
               Sheet5.cells(NextRow3, 9) = foundCell.Offset(0, 8).Value 'Writes End Time to Emission Form
              Sheet5.cells(NextRow3, 11) = foundCell.Offset(0, 10).Value 'Writes Emissions Values to Emission Form
             Sheet5.cells(NextRow3, 12) = foundCell.Offset(0, 11).Value 'Writes Emission Units to Emission Form
            Sheet5.cells(NextRow3, 13) = foundCell.Offset(0, 12).Value 'Writes Emission Type to Emission Form
           Sheet5.cells(NextRow3, 14) = foundCell.Offset(0, 13).Value 'Writes Emission Factor Numeric Values to Emission Form
          Sheet5.cells(NextRow3, 15) = foundCell.Offset(0, 14).Value 'Writes Emission Factor Numerator Units to Emission Form
         Sheet5.cells(NextRow3, 16) = foundCell.Offset(0, 15).Value 'Writes Emission Factor Denominator Units to Emission Form
        Sheet5.cells(NextRow3, 17) = foundCell.Offset(0, 16).Value 'Writes Material Code to Emission Form
       Sheet5.cells(NextRow3, 18) = foundCell.Offset(0, 17).Value 'Writes Material I/O Code to Emission Form
      Sheet5.cells(NextRow3, 19) = foundCell.Offset(0, 18).Value 'Writes Material Description to Emission Form
     Sheet5.cells(NextRow3, 21) = foundCell.Offset(0, 20).Value 'Writes Emission Calc Method Code to Emission Form
    Sheet5.cells(NextRow3, 22) = foundCell.Offset(0, 21).Value 'Writes Control Status to Emission Form
   Sheet5.cells(NextRow3, 23) = foundCell.Offset(0, 22).Value 'Writes Emission Data Level to Emission Form


                 
   If tempCell.Row >= foundCell.Row Then
   Exit For
   End If


 Next iLoop


Next Cell
        
50
100

Display More

Anonymous · Dec 2nd 2005

Re: Find method: using one range to search for all occurences in another

Your two tests on foundcell (one for nothing and one if its row is before the previously foun rows) should be put immediately after the Find and FindNext lines rather than after all the updating with foundcell's offsets has been done.

Anonymous · Dec 3rd 2005

Re: Find method: using one range to search for all occurences in another

I'm not sure if I've digested your code completed correctly, but it seems that you could shorten it quite a bit by using .COPY (with PASTE SPECIAL if your data has formulas in it). If your has not formulas, the code shortens further to a single line for each copy paste in the syntax of

Code

GetRange.Copy PutRange

Anyway, here is an example to play with.

Code

Option Explicit


Sub MatchCellCopyRng()
Dim c As Range, cCheck As Range
Dim DataSht As Worksheet, CkSht As Worksheet, PutSht As Worksheet


Set DataSht = Sheets("Data")
Set CkSht = Sheets("MatchedData")
Set PutSht = Sheets("PutData")


Application.ScreenUpdating = False


For Each c In DataSht.Range("A7:A" & DataSht.Range("A65536").End(xlUp).Row)
    If Len(c) <> 0 Then
        For Each cCheck In CkSht.Range("A7:A" & CkSht.Range("A65536").End(xlUp).Row)
            If WorksheetFunction.Trim(c) = WorksheetFunction.Trim(cCheck) Then
                DataSht.Range(c, c.Offset(0, 2)).Copy
                PutSht.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                DataSht.Range(c.Offset(0, 4), c.Offset(0, 8)).Copy
                PutSht.Range("A65536").End(xlUp).Offset(0, 4).PasteSpecial Paste:=xlPasteValues
                DataSht.Range(c.Offset(0, 10), c.Offset(0, 18)).Copy
                PutSht.Range("A65536").End(xlUp).Offset(0, 10).PasteSpecial Paste:=xlPasteValues
                DataSht.Range(c.Offset(0, 20), c.Offset(0, 22)).Copy
                PutSht.Range("A65536").End(xlUp).Offset(0, 20).PasteSpecial Paste:=xlPasteValues
            End If
        Next cCheck
    End If
Next c


Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Display More

ChrisBEE1 · Dec 3rd 2005

Re: Find method: using one range to search for all occurences in another

Thanks Guys!

I"ve been having a fit with this. And it seems the more I fiddled with this the more that it deteriorated. I will try both suggestion and let you know they turn out.

Thanks Again,
Chris

Find method: using one range to search for all occurences in another

Participate now!

Share