Locate and Move specific cells
 

Hi ;

Dave, your macro is really great. But on the other hand, the problem
is, I still can't find a way to copy the cells and leave the
originals. Could anyone please advise me how to? I have really tried
hard but always get another error message :(

Thanx for your interest.

cop.

<quote
If you didn't mean move, but meant copy (and leave the original cell
alone), there's sample code in VBA's help that will show you how to
keep track of the
address of the first found cell. Then you keep finding the value until
you hit that saved address.


--
coperniqPosted from http://www.pcreview.co.uk/ newsgroup access

This is referring to a post from June of 2004--so it's pretty old!

This was the original suggestion:

Option Explicit
Sub testme()

Dim myWords As Variant
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim FoundCell As Range
Dim iCtr As Long
Dim oRow As Long

myWords = Array("asdf8", "asdf24", "asdf33")

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

oRow = 0
With curWks
For iCtr = LBound(myWords) To UBound(myWords)
Set FoundCell = Nothing
Do
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
Exit Do
Else
oRow = oRow + 1
With newWks.Cells(oRow, "A")
.Value = myWords(iCtr)
.Offset(0, 1).Value = FoundCell.Address
End With
FoundCell.ClearContents
End If
End With
Loop
Next iCtr
End With

End Sub

See that FoundCell.clearcontents line. That's the line that empties the cell.
If you want it untouched, just remove that line.

coperniq wrote:

Hi ;

Dave, your macro is really great. But on the other hand, the problem
is, I still can't find a way to copy the cells and leave the
originals. Could anyone please advise me how to? I have really tried
hard but always get another error message :(

Thanx for your interest.

cop.

<quote
If you didn't mean move, but meant copy (and leave the original cell
alone), there's sample code in VBA's help that will show you how to
keep track of the
address of the first found cell. Then you keep finding the value until
you hit that saved address.

--
coperniqPosted from http://www.pcreview.co.uk/ newsgroup access

--

Dave Peterson

Ignore this post.

You have a good answer at your other post in .programming.

(I should have looked at the old code closer.)



Dave Peterson wrote:

This is referring to a post from June of 2004--so it's pretty old!

This was the original suggestion:

Option Explicit
Sub testme()

Dim myWords As Variant
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim FoundCell As Range
Dim iCtr As Long
Dim oRow As Long

myWords = Array("asdf8", "asdf24", "asdf33")

Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add

oRow = 0
With curWks
For iCtr = LBound(myWords) To UBound(myWords)
Set FoundCell = Nothing
Do
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
Exit Do
Else
oRow = oRow + 1
With newWks.Cells(oRow, "A")
.Value = myWords(iCtr)
.Offset(0, 1).Value = FoundCell.Address
End With
FoundCell.ClearContents
End If
End With
Loop
Next iCtr
End With

End Sub

See that FoundCell.clearcontents line. That's the line that empties the cell.
If you want it untouched, just remove that line.

coperniq wrote:

Hi ;

Dave, your macro is really great. But on the other hand, the problem
is, I still can't find a way to copy the cells and leave the
originals. Could anyone please advise me how to? I have really tried
hard but always get another error message :(

Thanx for your interest.

cop.

<quote
If you didn't mean move, but meant copy (and leave the original cell
alone), there's sample code in VBA's help that will show you how to
keep track of the
address of the first found cell. Then you keep finding the value until
you hit that saved address.

--
coperniqPosted from http://www.pcreview.co.uk/ newsgroup access

--

Dave Peterson

--

Dave Peterson

Now I have modified and combined Jim's and Dave's codes together. (Just
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? (I
don't need a new code. As I said this is just for learning the possible
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 Sub


--
coperniqPosted from http://www.pcreview.co.uk/ newsgroup access

You always paste into the same cell.

After you paste each of them, you'll want to determine the next "rngtopaste".

spoiler alert--code follows....

..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
..
Option Explicit
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 _
Destination:=rngToPaste
Set rngToPaste = newWks.Range("A65536").End(xlUp).Offset(1, 0)
End If
End With
Next iCtr
End With
End Sub



coperniq wrote:

Now I have modified and combined Jim's and Dave's codes together. (Just
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? (I
don't need a new code. As I said this is just for learning the possible
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 Sub

--
coperniqPosted from http://www.pcreview.co.uk/ newsgroup access

--

Dave Peterson