VBA: Moving Rows to Different Sheet Based on Multiple Variables

[Yeosinner]

Hello! I'm trying to automate a tedious process using the base code below.

Sub ArtsnSci()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("AllCourses").UsedRange.Rows.Count
    J = Worksheets("ArtsnSci").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("ArtsnSci").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("AllCourses").Range("C2:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "BIO" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("ArtsnSci").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

This works fine to move all of the rows containing BIO, but each college has multiple courses. I'd like to be able to find a way to automate *all* of the relevant course codes to move into the ArtsnSci sheet. Is there a way to make it transfer all rows containing, for example, BIO, HIST, PHYS, or CHEM into the ArtsnSci sheet without replacing the "BIO" in the code with "HIST" and re-running each time?

 

[dave3009]

You can try replacing this line

If CStr(xRg(K).Value) = "BIO" Then

with

If InStrRev("|BIO|HIST|PHYS|CHEM|", "|" & CStr(xRg(K).Value) & "|") > 0 Then

 

[Yeosinner]

You can try replacing this line

If CStr(xRg(K).Value) = "BIO" Then

with

If InStrRev("|BIO|HIST|PHYS|CHEM|", "|" & CStr(xRg(K).Value) & "|") > 0 Then

Thank you for the suggestion! I went ahead and tried this and unfortunately it pulled a lot of rows that did not contain the course codes, but some were pulled correctly. I believe this is because column C (the one I'm searching for the BIO|HIST|PHYS in) is a formula that, when moved, is referencing the wrong courses.

Is there a way to copy just the values of a row rather than the formula?

 

[Yeosinner]

Update:
I have solved the original question by using a different template code to copy the rows without deleting the original. That combined with Dave's edits & another solution found in another thread to copy values and not formulas worked perfect! For anyone else with a similar problem, here is end result.

Sub MoveRowBasedOnCellValue()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("AllCourses").UsedRange.Rows.Count
    J = Worksheets("Languages").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Languages").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("AllCourses").Range("C2:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If InStrRev("|JPN|KOR|ITAL|FR|", "|" & CStr(xRg(K).Value) & "|") > 0 Then
            xRg(K).EntireRow.Copy
            Worksheets("Languages").Range("A" & J + 1).PasteSpecial Paste:=xlPasteValues
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub