Cut and paste whole rows into the right sheet depending on whether the row contains a particular word in any column

[hollypa]

Hello experts,

I’m new to Excel, but I’ve grasped the concept of basic macros in VB. I’m now trying to create a macro that cuts and pastes whole rows into a different sheet depending on whether they have a particular word in any column. This is a little beyond my expertise, and I would be very grateful for any assistance offered please!

In this example, I’d like to cut and paste all rows that mention the word “Arts” in either column 7, 9, 11, 13, 15 or 17 and paste it in the worksheet titled “Arts” in the next available empty row. The same for the word “Engineering” and the word “Science” into the “Engineering” and “Science” worksheets respectively.

I realise this will mean that some rows are repeated in different sheets because for example, they have “Arts” in column 7 and “Engineering” in column 9 they will appear on both the “Arts” and the “Engineering” worksheet.

Any help would be very much appreciated please!

 

[sijpie]

This is fairly simple to acomplish, once you get your head around it.

Option Explicit

Sub MoveLines()
    Dim rFound As Range
    Dim lRow As Long, FstAddress As String
    Dim Subj As Variant
    Dim SearchStr(1 To 3)  As String
    
    SearchStr(1) = "Arts"
    SearchStr(2) = "Science"
    SearchStr(3) = "Engineering"
    
    With Union(Range("G:G"), Range("I:I"), Range("K:K"), Range("M:M"), Range("O:O"), Range("Q:Q"))
        For Each Subj In SearchStr
            Set rFound = .Find(What:=Subj, after:=Range("G1"), Searchorder:=xlByRows, MatchCase:=True)
            If Not rFound Is Nothing Then
                FstAddress = rFound.Address
                Do
                    rFound.EntireRow.Copy
                    Sheets(Subj).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0). _
                        PasteSpecial
                Loop While Not rFound Is Nothing And rFound.Address <> FstAddress
            End If
        Next str
    End With
End Sub

Use the Range().Find method to find the text you are after (look up Find Method for Range objects in the macro help)

 

[hollypa]

Thank you for this. I've had a go at running it but it comes up with an error, "complile error: argument not optional" and highlights the 'Str' part of Next Str at the bottom. Is there somehting I can do to fix this?

Cheers!

 

[sijpie]

Sorry, 'str' should have been 'subj'.

But I found another error as well, forgot to add the .findnext.

So here is the corrected code, and it works fine on my example. Let me know the results.

Sub MoveLines()
    Dim rFound As Range
    Dim lRow As Long, FstAddress As String
    Dim Subj As Variant
    Dim SearchStr(1 To 3)  As String
    
    SearchStr(1) = "Arts"
    SearchStr(2) = "Science"
    SearchStr(3) = "Engineering"
    
    With Union(Range("G:G"), Range("I:I"), Range("K:K"), Range("M:M"), Range("O:O"), Range("Q:Q"))
        For Each Subj In SearchStr
            Set rFound = .Find(What:=Subj, after:=Range("G1"), Searchorder:=xlByRows, MatchCase:=True)
            If Not rFound Is Nothing Then
                FstAddress = rFound.Address
                Do
                    rFound.EntireRow.Copy
                    Sheets(Subj).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0). _
                        PasteSpecial
                    Set rFound = .FindNext(rFound)
                Loop While Not rFound Is Nothing And rFound.Address <> FstAddress
            End If
        Next Subj
    End With
End Sub

 

[hollypa]

You are awesome! That works perfectly! Thank you so much for you help.