Find and Move Data

[Guest]

I've got column A with a data type of text. I'm trying to create a macro
that will find certain text ("Open Time") within column A then cut and paste
the row where "Open Time" exists into a new row.

For example, let's say "Open Time" is in cell A27. I want to find row 27
and cut and paste this row of information into say row 49. The trouble is
"Open Time" can appear in different rows each time.

Many thanks if you can help with the writing of this macro!

 

[Guest]

hi stan,
the find part is easy but a little more info might be required.
1. does "open time" appear more that once. if so which one do you want? how
to identify?
2. where do you want it pasted? macros are pretty specific and we need a
specific, exact place to paste. the paste may vary but how to identify.
3. if your are going to be using this alot, i don't recomend that you use
cut and paste. in a macro, this causes memory problems perticularly in a
loop. you don't seem to be needing a loop but i just get squimish using cut
and paste in a macro. variables may be better and have one variable's value =
another variable's value which would avoid cut and paste all togeather.

post back with more info.

regards
FSt1

 

[Guest]

Many thanks for the quick reply!

No, "Open Time" will only appear in column A one time. The paste location
will be in a static cell each time.

 

[Guest]

hi,
what do yo mean by static cell. next blank cell in the column?

regards
FSt1

 

[Guest]

Many apologies for not being clear. I need the row that contains "Open Time"
to go to the bottom of the list in column 'A' or as you say the next blank
cell in the column.

 

[Guest]

try this
Sub OpenTime()
Dim strdummy As String

Cells.Find(What:="OPENTIME", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase _
:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range(Selection, Selection.End(xlDown)).Select
strdummy = "dummy to get this to work"

If ActiveCell.Value = strdummy Then
'
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell <> "" Then


Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If

ActiveSheet.Paste
Range("A2").Select

End Sub

 

[Guest]

Is it possible to convert this to a macro?

try this
Sub OpenTime()
Dim strdummy As String

Cells.Find(What:="OPENTIME", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase _
:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range(Selection, Selection.End(xlDown)).Select
strdummy = "dummy to get this to work"

If ActiveCell.Value = strdummy Then
'
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell <> "" Then


Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If

ActiveSheet.Paste
Range("A2").Select

End Sub

 

[Guest]

It is a macro but try this

Sub OpenTime()
Dim strdummy As String

Cells.Find(What:="OPENTIME", After:=ActiveCell, _
LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase _
:=False, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range(Selection, Selection.End(xlDown)).Select
strdummy = "dummy to get this to work"

If ActiveCell.Value = strdummy Then
'
ActiveCell.Offset(1, 0).Select
End If
If ActiveCell <> "" Then


Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If

ActiveSheet.Paste
Range("A2").Select

End Sub

 

[Guest]

hi stan,
sorry to be so long getting back. we did discuss what you wanted to do with
the blank row we cut out. so i winged it. see bottom of code. post back if
you have problmes.
Sub FindMacro1()
Dim rng As Range
Cells(1, 1).Select
Set rng = Range("A1:IV65400").Find(what:="Open Time", _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Range(rng, rng.End(xlToRight)).Cut
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
'we didn't discuss this part
ActiveCell.Select
ActiveCell.End(xlUp).Offset(-1, 0).Select
Selection.EntireRow.Delete 'deletes the blank row we cut.
End Sub

regards
FSt1