VBA Code - Find & Move

Y

Youlan

Hi,

I'm using MS Excel 2002 and I'm trying to write a code to FIND "699999" in a
worsheet and once found, move (or copy and paste) it three rows above (but
same column) from where it was originally. I need a code because this search
criteria does not always have the same cell reference but where I need it to
be placed is always three rows above.

I would greatly appreciate any help with this. Thanks in advance.

Regards,
 
R

Ron de Bruin

Hi Youlan

Try this one for this range (all cells in Sheet1)
With Sheets("Sheet1").UsedRange

Try it on a copy of your workbook

Sub test()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim I As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

MyArr = Array(699999)

'Search Column or range
With Sheets("Sheet1").UsedRange

For I = LBound(MyArr) To UBound(MyArr)

Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
If Rng.Row > 3 Then
Rng.Offset(-3, 0).Value = Rng.Value
Rng.Value = ""
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 
Y

Youlan

Hi Ron,

Thanks for your response but I'm having a little problem.

The macro takes a very long time to run and I'm not able to use excel for
that time. I actually have to press escape in order for it to stop and the I
get a runtime error (unable to get the findnext property of the range class).

Also the first time I ran it it moved the 699999 to position B1 as opposed
to the 3 rows above where it was originally. When I tried to run it again
though it moved it to the correct position. I'm not sure why this would have
happened. I tried running it again (just a while ago) and it caused excel to
"hang".

If you're still able to help I'd like to expand my request a little:

The following info will always be in columns A & B:

Parent & 699999 respectively

They will appear nowhere else in the worksheet so once found we would'nt
have to search for them again.

Once found I would like to move both of them to positions three rows
directly above.
 
R

Ron de Bruin

The macro takes a very long time to run
I am sleeping sorry, the code is not correct.

Will post a good example after dinner and test it first for you
You can do two things the same time <g>
 
Y

Youlan

ok thanks...I await your response

Ron de Bruin said:
I am sleeping sorry, the code is not correct.

Will post a good example after dinner and test it first for you
You can do two things the same time <g>
Click to expand...
 
D

Dave Peterson

It always scares me to modify values inside that loop. I put some test data in
A12, B12, C12 and ran it once. After it found and moved the 3 value to C9, the
..findnext() failed. For some reason, it didn't see the stuff in row 9.

It failed with run-time error '91':
Object variable or With block variable not set

I expected the code to be able to find those values in row 9, but never exit the
loop--since the found address would never be the same as the FirstAddress.

I think I'd approach it by finding all the cells with that value, build a
giant(?) range and process each cell in that range.

Option Explicit
Sub test()
Dim FirstAddress As String
Dim MyVal As Variant
Dim FoundCell As Range
Dim AllCells As Range
Dim myCell As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

MyVal = 699999

'Search Column or range
With Sheets("Sheet1").UsedRange
Set FoundCell = .Find(What:=MyVal, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
'do nothing,
MsgBox "None Found!"
Else
FirstAddress = FoundCell.Address
Do
If AllCells Is Nothing Then
Set AllCells = FoundCell
Else
Set AllCells = Union(AllCells, FoundCell)
End If

Set FoundCell = .FindNext(FoundCell)
If FoundCell Is Nothing Then
'shouldn't happen
Exit Do
End If
If FoundCell.Address = FirstAddress Then
Exit Do
End If
Loop

For Each myCell In AllCells.Cells
If myCell.Row < 4 Then
MsgBox "Error with: " & myCell.Address(0, 0)
Else
myCell.Offset(-3, 0).Value = myCell.Value
myCell.Value = ""
End If
Next myCell
End If
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

===========
To the OP:

The only time I've seen these kinds of things take a really long time is when I
use Merged cells. And merged cells can really screw up the .find/.findnext.
Under certain conditions, excel will go into an endless loop and you'll need to
interrupt the code to break out.

If you're using merged cells, stop! They're miserable to work with.
 
R

Ron de Bruin

Maybe this Dave

Sub test()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rng2 As Range
Dim I As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

MyArr = Array(699999)

With Sheets("Sheet1").Range("A:B")
Set Rng2 = .Find(What:=MyArr(I), _
After:=.Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

If Rng2.Row < 4 Then Exit Sub

For I = LBound(MyArr) To UBound(MyArr)
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Rng Is Nothing Then
Do
If Rng.Row > 3 Then
Rng.Offset(-3, 0).Value = Rng.Value
Rng.Value = ""
If Rng.Address = Rng2.Address Then Exit Do
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing
End If
Next I
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 
R

Ron de Bruin

Better to restore the events and screenupdating if this is true
If Rng2.Row < 4 Then GoTo StopTheMacro


Sub test2()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rng2 As Range
Dim I As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

MyArr = Array(699999)

With Sheets("Sheet1").Range("A:B")
Set Rng2 = .Find(What:=MyArr(I), _
After:=.Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

If Rng2.Row < 4 Then GoTo StopTheMacro

For I = LBound(MyArr) To UBound(MyArr)
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Rng Is Nothing Then
Do
If Rng.Row > 3 Then
Rng.Offset(-3, 0).Value = Rng.Value
Rng.Value = ""
If Rng.Address = Rng2.Address Then Exit Do
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing
End If
Next I
End With

StopTheMacro:

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 
Y

Youlan

Hi Ron,

Thanks a lot. This works perfectly, but I also want the macro to search for
"Parent" (it's in column A) and move it up 3 rows as well. How can I amend
the code to incorporate this?
 
R

Ron de Bruin

Ok, test this one (start look like real code now <g>)

It will use column A:B for both values.
Is that a problem ?


Sub Test3()
Dim MyArr As Variant
Dim Rng As Range
Dim Rng2 As Range
Dim I As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

MyArr = Array(699999, "Parent")

With Sheets("Sheet1").Range("A:B")

For I = LBound(MyArr) To UBound(MyArr)
Set Rng = Nothing
Set Rng2 = Nothing

Set Rng2 = .Find(What:=MyArr(I), _
After:=.Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

If Not Rng2 Is Nothing Then
If Rng2.Row < 4 Then GoTo NextInArray

Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Rng Is Nothing Then
Do
If Rng.Row > 3 Then
Rng.Offset(-3, 0).Value = Rng.Value
Rng.Value = ""
If Rng.Address = Rng2.Address Then Exit Do
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing
End If
End If

NextInArray:
Next I
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 
D

Dave Peterson

Just to add...

I still don't understand why the .findnext() doesn't find the moved value. And
I don't like to rely (too much!) on things I don't understand.



Dave said:
I think I'd still build the range and process that range separately.
Click to expand...
<<snipped>>
 
Y

Youlan

Thanks a million Ron...this works perfectly.

Ron de Bruin said:
Ok, test this one (start look like real code now <g>)

It will use column A:B for both values.
Is that a problem ?


Sub Test3()
Dim MyArr As Variant
Dim Rng As Range
Dim Rng2 As Range
Dim I As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

MyArr = Array(699999, "Parent")

With Sheets("Sheet1").Range("A:B")

For I = LBound(MyArr) To UBound(MyArr)
Set Rng = Nothing
Set Rng2 = Nothing

Set Rng2 = .Find(What:=MyArr(I), _
After:=.Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

If Not Rng2 Is Nothing Then
If Rng2.Row < 4 Then GoTo NextInArray

Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not Rng Is Nothing Then
Do
If Rng.Row > 3 Then
Rng.Offset(-3, 0).Value = Rng.Value
Rng.Value = ""
If Rng.Address = Rng2.Address Then Exit Do
End If
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing
End If
End If

NextInArray:
Next I
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Click to expand...
 
R

Ron de Bruin

Oh, boy. If you're laughing and she asks why, you better lie <vbg>!

I am Safe, she is sleeping Dave
 
R

Ron de Bruin

Hi Youlan

You are welcome

Read also Dave's reply good because he is much smarter then me.
 
Top