If Cell contains specific text then Cut 3 cells to different location?

[NessPJ]

Hey all,

I have a sheet containing 2 "Areas" which each have 3 columns of Data. Both are fairly similar, yet for my use i want to do the folowing:

Area 1:
Column C, D and E
Column C = Route number
Column D = Trailer number
Column E = Departure time

Area 2:
Column G, H and I
Column G = Route number
Column H = Transporter
Column I = Departure time

I am looking for a code that will search for a specific Transporter name in Column H. When it has found it, i want it to Cut this Cell as well as the 2 Cells next to it on the same Row (so the cells in columns G and I).

Then i want the code to paste the cut cells on the first available Row of Cells in Area 1 (Columns C, D and E).

This code should loop until the Transporter name i am looking for is no longer present in Column H.

--

I tried creating a macro that will Find the transporter name and will Cut the cells in question, but i don't know how i will make my code specify to cut the other 2 cells in the same row nor do i know how to make it loop.

Any help would be greatly appreciated.

 

[Peter_SSs]

If you are searching in H but still cutting G:I, then try this version.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> SearchAndMove()<br>    <SPAN style="color:#00007F">Dim</SPAN> Found <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    <SPAN style="color:#00007F">Const</SPAN> SrchCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "H"<br>    <SPAN style="color:#00007F">Const</SPAN> SrchTxt <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "GND"<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Columns(SrchCol)<br>        <SPAN style="color:#00007F">Set</SPAN> Found = .Find(What:=SrchTxt, After:=.Cells(1, 1), _<br>            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _<br>            MatchCase:=False, SearchFormat:=False)<br>        <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Found <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">Do</SPAN><br>                Found.Offset(0, -1).Resize(1, 3).Cut _<br>                    Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1)<br>                <SPAN style="color:#00007F">Set</SPAN> Found = .FindNext<br>            <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">Until</SPAN> Found <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[Peter_SSs]

...the text to search for it in Column "H".

I see that you did say that in post #6 but I was sure when I first looked the H was missing so I assumed you were using G per your code.
Perhaps I'm going blind.

 

[NessPJ]

I had to change the code a little because the selection had to change after some reconsidering...

    Dim Found As Range
 
    Const SrchCol As String = "H"
    Const SrchTxt As String = "GND"
 
    With Columns(SrchCol)
        Set Found = .Find(What:=SrchTxt, After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not Found Is Nothing Then
            Do
                Union(Found.Offset(0, -1), Found.Offset(0, 1).Resize(, 2)).Copy _
                    Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1)
                Set Found = .FindNext
            Loop Until Found Is Nothing
        End If
    End With

I changed this (using the Union and Offset functions) with help from another thread.
But, since i use the Union function a "Cut" will no longer work and i am inclined to use a "Copy" function.
Yet, this will result in the code constantly repeating itself (because the GND value will stay present in column H).

Would it be possible to copy the preferred selection, then do a delete on the row where the GND value was found (column G, H, I and J) and then go to the next step in the code?

 

[Peter_SSs]

Can you explain just what you are now trying to achieve?

It looks a bit like you are trying to search in column H but copy values from columns G, I & J. Is that correct?

Do your want to delete the values from any of the G:J columns after the copy? If so, which columns do you want to delete? Do you just want to delete the values from the cells and leave the cells empty or do you want to actually delete the whole cell and move the cells below up a row?

It would be very helpful if you could make up a small dummy set of data (say 10-15 rows) and post a screen shot of 'Before' and 'After'. My signature block below contains 3 methods for posting small screen shots. Test them in the Test Here forum. That way, if something goes wrong, you won’t be messing up a main forum. Have you tried any of those?

 

[NessPJ]

Hey,

I got the code working now by changing it to look like this:

    Dim Found As Range
    
    Const SrchCol As String = "H"
    Const SrchTxt As String = "GND"
    
    With Columns(SrchCol)
        Set Found = .Find(What:=SrchTxt, After:=.Cells(1, 1), _
            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not Found Is Nothing Then
            Do
            With Union(Found.Offset(0, -1), Found.Offset(0, 1).Resize(, 2))
                .Copy Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1)
                Found.Offset(0, -1).Resize(, 4).ClearContents
            End With
            
                Set Found = .FindNext
            Loop Until Found Is Nothing
        End If
    End With

So yes, i want the cells G:J emptied after copying the found data to the first available Cells on C:E.

 

[Peter_SSs]

Glad you got it going.

Definitely isn't a big issue but one comment about the code. In this section ..

With Union(Found.Offset(0, -1), Found.Offset(0, 1).Resize(, 2))
    .Copy Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1)
    Found.Offset(0, -1).Resize(, 4).ClearContents
End With

.. you don't really need the 'With ... End With' structure since you are only doing one thing with that Union range - copying it.
So the following should serve the same purpose

Union(Found.Offset(0, -1), Found.Offset(0, 1).Resize(, 2)).Copy _
    Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1)
Found.Offset(0, -1).Resize(, 4).ClearContents

 

[NessPJ]

Thanks for the final heads up, i'm always keen to learn.
(Perhaps if i'm lucky enough i will be able to concince my boss to throw in a decent VBA course :P).