VBA search column for strings and copy row to new

Question

Not really good at VBA here. Found and edited some code that I believe can help me. I need this code to search 2 columns (L and M) for any string in those columns that ends with _LC _LR etc... Example: xxxxxxxx_LC . If the cell ends with anything in the array, I need the row to be copied to a new sheet. Here is what I have:

 Option Explicit

Sub Test()

Dim rngCell As Range
Dim lngLstRow As Long
Dim keywords() As String
Dim maxKeywords As Integer


maxKeywords = 6
ReDim keywords(1 To maxKeywords)

maxKeywords(1) = "_LC"
maxKeywords(2) = "_LR"
maxKeywords(3) = "_LF"
maxKeywords(4) = "_W"
maxKeywords(5) = "_R"
maxKeywords(6) = "_RW"

lngLstRow = ActiveSheet.UsedRange.Rows.Count

For Each rngCell In Range("L2:L, M2:M" & lngLstRow)
    For i = 1 To maxKeywords
            If keywords(i) = rngCell.Value Then
                rngCell.EntireRow.Copy
                    Sheets("sheet1").Select
                        Range("L65536, M65536").End(xlUp).Offset(1, 0).Select
                        Selection.PasteSpecial xlPasteValues
                    Sheets("Results").Select

            End If
        Next i
Next

End Sub

Answer 1

Okay, the issue I think is with your variable declarations. Before I continue, I will echo @GradeEhBacon's comment that if you can't read this and understand what's going on, you may want to take some time to learn VBA before running.

This should work, AFAIK. You didn't specify which sheet has what info, so that may have to be tweaked. Try the below, and let me know what is/isn't working:

Sub Test()

Dim rngCell As Range
Dim lngLstRow As Long
Dim keywords() As String, maxKeywords() As String
Dim totalKeywords As Integer, i&
Dim ws As Worksheet, resultsWS As Worksheet

Set ws = Sheets("Sheet1")
Set resultsWS = Sheets("Results")

totalKeywords = 6
ReDim keywords(1 To totalKeywords)
ReDim maxKeywords(1 To totalKeywords)

maxKeywords(1) = "_LC"
maxKeywords(2) = "_LR"
maxKeywords(3) = "_LF"
maxKeywords(4) = "_W"
maxKeywords(5) = "_R"
maxKeywords(6) = "_RW"

 lngLstRow = ws.UsedRange.Rows.Count  'Assuming "Sheet1" is what you want to get the last range of.

Dim k&                       ' create a Long to use as Column numbers for the loop
For k = 12 To 13             ' 12 is column L, 13 is M
    With ws                  'I'm assuming your Ranges are on the "Sheet1" worksheet
        For Each rngCell In .Range(.Cells(1, k), .Cells(lngLstRow, k))
            For i = LBound(maxKeywords) To UBound(maxKeywords)
                If maxKeywords(i) = Right(rngCell.Value, 3) or maxKeywords(i) = Right(rngCell.Value, 2) Then
                    ' rngCell.EntireRow.Copy
                    ' ws.Range("L65536, M65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    resultsWS.Cells(65536, k).End(xlUp).Offset(1, 0).EntireRow.Value = rngCell.EntireRow.Value
                End If
            Next i
        Next rngCell
    End With
Next k
End Sub

Answer 2

This might be what you are looking for:

==================================================

Option Explicit

Sub Test()

Dim rngCell As Range
Dim lngLstRow As Long
Dim keywords() As String
Dim maxKeywords, i, j, k As Integer


maxKeywords = 6
ReDim keywords(1 To maxKeywords)

keywords(1) = "_LC"
keywords(2) = "_LR"
keywords(3) = "_LF"
keywords(4) = "_W"
keywords(5) = "_R"
keywords(6) = "_RW"

lngLstRow = ActiveSheet.UsedRange.Rows.Count

For j = 1 To lngLstRow
  For i = 1 To maxKeywords
    If keywords(i) = Right(Sheets("Results").Range("L" & j).Value,     Len(keywords(i))) Or _
      keywords(i) = Right(Sheets("Results").Range("M" & j).Value, Len(keywords(i))) Then
        k = k + 1
          Rows(j & ":" & j).Copy
            Sheets("sheet1").Select
              Range("A" & k).Select
                ActiveSheet.Paste
    End If
  Next i
Next j

End Sub