VBA Code - Find & Move

  • Thread starter Thread starter Youlan
  • Start date Start date
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,
 
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
 
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.
 
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>
 
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...
 
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.
 
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
 
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
 
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?
 
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
 
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>>
 
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...
 
Oh, boy. If you're laughing and she asks why, you better lie <vbg>!

I am Safe, she is sleeping Dave
 
Hi Youlan

You are welcome

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Code - Find & Move 4
VBA code Required to Run the Multiple VBA Codes 6
Moving Formulas when Sorting 2
Macro for Search 6
Copy paste data from a column to a row 0
VB Code Help - locate and sum 4
VBA Code to Automatically move text into above cells? 3
Macro Code 4

Back
Top