Solved

Move Row If Column Contains Specific Text

Posted on 2013-06-25
3
563 Views
Last Modified: 2013-06-26
I'm having trouble with my simple code where it looks in column V for the word 'Shipped' and then cuts the entire row and pastes it to another worksheet in my workbook. I keep getting an Error 400. Any help would be wonderful.

Dim shPrint As Worksheet
    Dim shConf As Worksheet
    Dim MyRange As Range
    Dim FindMyRange As Range

    Set shPrint = Worksheets("Print")
    Set shConf = Worksheets("Confirmation")
    Set MyRange = Intersect(Columns("V"), shPrint.UsedRange)
    Set FindMyRange = MyRange.Find(What:=Shipped, LookIn:=xlValues)
    
    If Not FindMyRange Is Nothing Then
    
        Do
    
        Application.CutCopyMode = False
        shPrint.Range(Range("A" & IdxRow), Range("W" & IdxRow)).Cut _
            Destination:=shConf.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        shPrint.Cells(IdxRow, 1).EntireRow.Delete Shift:=xlUp
        Set FindMyRange = MyRange.FindNext
        Loop While Not FindMyRange Is Nothing
    End If
  

Open in new window

0
Comment
Question by:Southern_Gentleman
3 Comments
 
LVL 1

Expert Comment

by:tessupport
ID: 39277509
i think your better off using a filter rather than a loop. first apply a filter to col V = Shipped, copy data to your other tab, then delete the filtered results

here is and example of filter and delete, you will just have to customise it to your sheet and add the move data code in

Sub G()
   
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
   
    With Range("A1:C1")
        If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.Range.AutoFilter
        .AutoFilter field:=2, Criteria1:="1"
        Range("A2:C" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With

End Sub
0
 
LVL 14

Accepted Solution

by:
Faustulus earned 500 total points
ID: 39280301
Southern_Gentleman,
Your code works just fine. I tuned it up a little, that's all:-
Option Explicit

Private Sub Test()
    
    Const Shipped As String = "shipped"
    
    Dim shPrint As Worksheet
    Dim shConf As Worksheet
    Dim MyRange As Range
    Dim FindMyRange As Range
    Dim IdxRow As Long

    Set shPrint = Worksheets("Print")
    Set shConf = Worksheets("Confirmation")
    Set MyRange = Intersect(shPrint.Columns("V"), shPrint.UsedRange)
    Set FindMyRange = MyRange.Find(What:=Shipped, LookIn:=xlValues)
    
    If Not FindMyRange Is Nothing Then
        Do
            Application.CutCopyMode = False
            IdxRow = FindMyRange.Row
            shPrint.Range(Range("A" & IdxRow), Range("W" & IdxRow)).Cut _
                Destination:=shConf.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            shPrint.Cells(IdxRow, 1).EntireRow.Delete Shift:=xlUp
            Set FindMyRange = MyRange.FindNext
        Loop While Not FindMyRange Is Nothing
    End If
End Sub

Open in new window

You can make your life easier if you use Option Explicit at the top of each code sheet. Most of the errors I found were discovered with the help of this tool.

I would also like to share this function with you:-
Function FindRow(ByVal SearchFor As Variant, _
                 SearchIn As Range, _
                 Optional ByVal SearchAfter As Long = 1, _
                 Optional ByVal SearchDir As Long = xlNext, _
                 Optional ByVal SearchCase As Boolean = True) _
                 As Long
    ' 0084 V 1.0
    Dim Fnd As Range
    Dim R As Long
    If SearchAfter = 0 Then SearchAfter = SearchIn.Cells.Count
    With SearchIn
    Set Fnd = .Find(What:=SearchFor, _
                    After:=.Cells(SearchAfter), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=SearchDir, _
                    MatchCase:=SearchCase)
    End With
    If Not Fnd Is Nothing Then
    R = Fnd.Row
    If R <> SearchAfter Then FindRow = R
    End If
End Function

Open in new window

It has two advantages over the code you use. First, it returns the row which, after all, is all you really want. You would call it like,
IdxRow = FindRow(Shipped) in your procedure.
Second, it returns 0 if nothing is found which you can use for your loop.
Third, it lists all the criteria you didn't set and sets them to the defaults you want to use so that you don't need to look up MSDN in order to know what your function is doing.

Finally, I am surprised that this line of code actually works:-
shConf.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
I would have written shConf.Cells(Rows.Count, "A").End(xlUp).Row +1
But apparently the Row is the default property of the Offset method or Excel somehow divines the intention. I would have expected the default be the Value because Offset defines a range. Generally speaking, I dislike leaving it up to Excel to decide what I want, meaning I would specify Row if it is the Row number that I am after. And, of course, since I am thinking of a number, not a range, I find it more logical to use +1 rather than Offset(0,1).

Actually, I am waging some kind of private vendetta against the above method of finding the last row because it is a very sensitive piece of equipment which not only lays traps as shown above but also doesn't always work as expected because it has a lot of fine print in its rules. I use this function:-
Function LastRow(Optional ByVal Col As Variant, Optional Ws As Worksheet) As Long
    Dim R As Long
    If Ws Is Nothing Then Set Ws = ActiveSheet
    If VarType(Col) = vbError Then Col = 1
    With Ws
    R = .Cells(.Rows.Count, Col).End(xlUp).Row
    With .Cells(R, Col)
    If R = 1 And .Value = vbNullString Then R = 0
    LastRow = R + .MergeArea.Rows.Count - 1
    End With
    End With
End Function

Open in new window

You can call it with LastRow("A", shPrint) in your project and use
LastRow("A", shPrint) + 1
I like it because it is uncomplicated to call, especially since both parameters are optional, and much more reliable than the xlUp range. I put it in nearly every project.
0
 

Author Closing Comment

by:Southern_Gentleman
ID: 39280325
Thanks Faustilus for the extra code. Another great learning experience.
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now