Solved

Move Row If Column Contains Specific Text

Posted on 2013-06-25
3
601 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This article describes a serious pitfall that can happen when deleting shapes using VBA.
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…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

738 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