View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
coperniq[_2_] coperniq[_2_] is offline
external usenet poster
 
Posts: 1
Default Locate and Move Specific Cells


_Thanks_Jim,_

Your macro works great. I owe you :)

Now I have modified and combined Jim's and Dave's codes together. (Jus
for fun - kinda way to explore new things) The problem is
_it_pastes_the_results_over_the_first_found_cells_ .

For example: A table like

AAA
AAA
AAA
BBB
BBB
BBB
BBB
CCC
CCC

Condition is cells equals to "AAA" and "CCC" First it copies "AAA
cells to a column specified, then takes "CCC" and paste over "AAA"s
But I don't see any reason for this.

Result Should be:

AAA
AAA
AAA
CCC
CCC

Result is:

CCC
CCC
AAA


The code is below. Can anyone show where the problem(reason) is? (-
don't need a new code. As I said this is just for learning the possibl
relations. So please show which part of the code causes this result-.)

Thanks everybody.... :)

Cop.

Modified (Combined) Code:

Sub Copyer()

Dim myWords As Variant
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim rngFirst As Range
Dim FoundCell As Range
Dim rngToSearch As Range
Dim rngFoundCells As Range
Dim iCtr As Long
Dim oRow As Long
Dim rngToPaste As Range


myWords = Array("AAA", "CCC")

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets("sheet10")
Set rngToSearch = curWks.Cells
Set rngToPaste = newWks.Range("A65536").End(xlUp).Offset(1, 0)

oRow = 0

With curWks
Set FoundCell = Nothing
For iCtr = LBound(myWords) To UBound(myWords)
With .UsedRange
Set FoundCell = .Cells.Find(what:=myWords(iCtr), _
after:=.Cells(.Cells.Count), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)

If FoundCell Is Nothing Then
MsgBox "No words found."

Else
Set rngFirst = FoundCell
Set rngFoundCells = FoundCell.Offset(0, 0)
Do
Set rngFoundCells = Union(FoundCell.Offset(0, 0)
rngFoundCells)
Set FoundCell = rngToSearch.FindNext(FoundCell)
Loop Until rngFirst.Address = FoundCell.Address
rngFoundCells.Copy rngToPaste
End If
End With
Next iCtr
End With
End Su

--
coperni
-----------------------------------------------------------------------
coperniq's Profile: http://www.excelforum.com/member.php...fo&userid=2490
View this thread: http://www.excelforum.com/showthread.php?threadid=38437